PrimOp.hs

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns      #-}

--------------------------------------------------------------------------------
-- | Primitive Operations
-- Built-in operations that aren't actually compiled from
-- anywhere, they come from runtime.js.
--
-- They're in the names list so that they can be overriden by the user
-- in e.g. let a * b = a - b in 1 * 2.
--
-- So we resolve them to Fay$, i.e. the prefix used for the runtime
-- support. $ is not allowed in Haskell module names, so there will be
-- no conflicts if a user decicdes to use a module named Fay.
--
-- So e.g. will compile to (*) Fay$$mult, which is in runtime.js.

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

-- | Make an identifier from the built-in HJ module.
fayBuiltin :: a -> String -> QName a
fayBuiltin a = Qual a (ModuleName a "Fay$") . Ident a

-- | Mapping from unqualified names to qualified primitive names.
primOpsMap :: Map N.Name N.QName
primOpsMap = M.fromList
  [ (Symbol () ">>",     fayBuiltin () "then")
  , (Symbol () ">>=",    fayBuiltin () "bind")
  , (Ident  () "return", fayBuiltin () "return")
  , (Ident  () "force",  fayBuiltin () "force")
  , (Ident  () "seq",    fayBuiltin () "seq")
  , (Symbol ()  "*",     fayBuiltin () "mult")
  , (Symbol ()  "+",     fayBuiltin () "add")
  , (Symbol ()  "-",     fayBuiltin () "sub")
  , (Symbol ()  "/",     fayBuiltin () "divi")
  , (Symbol ()  "==",    fayBuiltin () "eq")
  , (Symbol ()  "/=",    fayBuiltin () "neq")
  , (Symbol ()  ">",     fayBuiltin () "gt")
  , (Symbol ()  "<",     fayBuiltin () "lt")
  , (Symbol ()  ">=",    fayBuiltin () "gte")
  , (Symbol ()  "<=",    fayBuiltin () "lte")
  , (Symbol ()  "&&",    fayBuiltin () "and")
  , (Symbol ()  "||",    fayBuiltin () "or")
  ]

-- | Lookup a primop that was resolved to a Prelude definition.
findPrimOp :: N.QName -> Maybe N.QName
findPrimOp (Qual _ (ModuleName _ "Prelude") s) = M.lookup s primOpsMap
findPrimOp _ = Nothing

-- | If this is resolved to a Prelude identifier or if it's unqualified,
-- check if it's a primop
resolvePrimOp :: QName a -> Maybe N.QName
resolvePrimOp (unAnn -> q) = case q of
  (Qual _ (ModuleName _ "Prelude") _) -> findPrimOp q
  (UnQual _ n) -> findPrimOp $ Qual () (ModuleName () "Prelude") n
  _ -> Nothing