{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module Fay.Compiler.PrimOp
( fayBuiltin
, findPrimOp
, resolvePrimOp
) where
import Fay.Compiler.Prelude
import Fay.Exts.NoAnnotation (unAnn)
import qualified Fay.Exts.NoAnnotation as N
import Data.Map (Map)
import qualified Data.Map as M
import Language.Haskell.Exts
fayBuiltin :: a -> String -> QName a
fayBuiltin :: a -> String -> QName a
fayBuiltin a :: a
a = a -> ModuleName a -> Name a -> QName a
forall l. l -> ModuleName l -> Name l -> QName l
Qual a
a (a -> String -> ModuleName a
forall l. l -> String -> ModuleName l
ModuleName a
a "Fay$") (Name a -> QName a) -> (String -> Name a) -> String -> QName a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String -> Name a
forall l. l -> String -> Name l
Ident a
a
primOpsMap :: Map N.Name N.QName
primOpsMap :: Map Name QName
primOpsMap = [(Name, QName)] -> Map Name QName
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[ (() -> String -> Name
forall l. l -> String -> Name l
Symbol () ">>", () -> String -> QName
forall a. a -> String -> QName a
fayBuiltin () "then")
, (() -> String -> Name
forall l. l -> String -> Name l
Symbol () ">>=", () -> String -> QName
forall a. a -> String -> QName a
fayBuiltin () "bind")
, (() -> String -> Name
forall l. l -> String -> Name l
Ident () "return", () -> String -> QName
forall a. a -> String -> QName a
fayBuiltin () "return")
, (() -> String -> Name
forall l. l -> String -> Name l
Ident () "force", () -> String -> QName
forall a. a -> String -> QName a
fayBuiltin () "force")
, (() -> String -> Name
forall l. l -> String -> Name l
Ident () "seq", () -> String -> QName
forall a. a -> String -> QName a
fayBuiltin () "seq")
, (() -> String -> Name
forall l. l -> String -> Name l
Symbol () "*", () -> String -> QName
forall a. a -> String -> QName a
fayBuiltin () "mult")
, (() -> String -> Name
forall l. l -> String -> Name l
Symbol () "+", () -> String -> QName
forall a. a -> String -> QName a
fayBuiltin () "add")
, (() -> String -> Name
forall l. l -> String -> Name l
Symbol () "-", () -> String -> QName
forall a. a -> String -> QName a
fayBuiltin () "sub")
, (() -> String -> Name
forall l. l -> String -> Name l
Symbol () "/", () -> String -> QName
forall a. a -> String -> QName a
fayBuiltin () "divi")
, (() -> String -> Name
forall l. l -> String -> Name l
Symbol () "==", () -> String -> QName
forall a. a -> String -> QName a
fayBuiltin () "eq")
, (() -> String -> Name
forall l. l -> String -> Name l
Symbol () "/=", () -> String -> QName
forall a. a -> String -> QName a
fayBuiltin () "neq")
, (() -> String -> Name
forall l. l -> String -> Name l
Symbol () ">", () -> String -> QName
forall a. a -> String -> QName a
fayBuiltin () "gt")
, (() -> String -> Name
forall l. l -> String -> Name l
Symbol () "<", () -> String -> QName
forall a. a -> String -> QName a
fayBuiltin () "lt")
, (() -> String -> Name
forall l. l -> String -> Name l
Symbol () ">=", () -> String -> QName
forall a. a -> String -> QName a
fayBuiltin () "gte")
, (() -> String -> Name
forall l. l -> String -> Name l
Symbol () "<=", () -> String -> QName
forall a. a -> String -> QName a
fayBuiltin () "lte")
, (() -> String -> Name
forall l. l -> String -> Name l
Symbol () "&&", () -> String -> QName
forall a. a -> String -> QName a
fayBuiltin () "and")
, (() -> String -> Name
forall l. l -> String -> Name l
Symbol () "||", () -> String -> QName
forall a. a -> String -> QName a
fayBuiltin () "or")
]
findPrimOp :: N.QName -> Maybe N.QName
findPrimOp :: QName -> Maybe QName
findPrimOp (Qual _ (ModuleName _ "Prelude") s :: Name
s) = Name -> Map Name QName -> Maybe QName
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
s Map Name QName
primOpsMap
findPrimOp _ = Maybe QName
forall a. Maybe a
Nothing
resolvePrimOp :: QName a -> Maybe N.QName
resolvePrimOp :: QName a -> Maybe QName
resolvePrimOp (QName a -> QName
forall (f :: * -> *) a. Functor f => f a -> f ()
unAnn -> QName
q) = case QName
q of
(Qual _ (ModuleName _ "Prelude") _) -> QName -> Maybe QName
findPrimOp QName
q
(UnQual _ n :: Name
n) -> QName -> Maybe QName
findPrimOp (QName -> Maybe QName) -> QName -> Maybe QName
forall a b. (a -> b) -> a -> b
$ () -> ModuleName () -> Name -> QName
forall l. l -> ModuleName l -> Name l -> QName l
Qual () (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () "Prelude") Name
n
_ -> Maybe QName
forall a. Maybe a
Nothing