module HERMIT.Dictionary.New where
import Control.Arrow
import HERMIT.Context
import HERMIT.Core
import HERMIT.Monad
import HERMIT.Kure
import HERMIT.External
import HERMIT.GHC
import HERMIT.ParserCore
import qualified Language.Haskell.TH as TH
externals :: [External]
externals = map ((.+ Experiment) . (.+ TODO))
[ external "var" (promoteExprT . isVar :: TH.Name -> TranslateH Core ())
[ "var '<v> returns successfully for variable v, and fails otherwise.",
"Useful in combination with \"when\", as in: when (var v) r" ] .+ Predicate
, external "prog-nonrec-intro" ((\ nm core -> promoteProgR $ progNonRecIntroR (show nm) core) :: TH.Name -> CoreString -> RewriteH Core)
[ "Introduce a new top-level definition."
, "prog-nonrec-into 'v [| e |]"
, "prog ==> ProgCons (v = e) prog" ] .+ Introduce .+ Shallow
, external "let-nonrec-intro" ((\ nm core -> promoteExprR $ letNonRecIntroR (show nm) core) :: TH.Name -> CoreString -> RewriteH Core)
[ "Introduce a new definition as a non-recursive let binding."
, "let-nonrec-intro 'v [| e |]"
, "body ==> let v = e in body" ] .+ Introduce .+ Shallow
]
isVar :: (ExtendPath c Crumb, AddBindings c, MonadCatch m) => TH.Name -> Translate c m CoreExpr ()
isVar nm = varT (arr $ cmpTHName2Var nm) >>= guardM
progNonRecIntroR :: String -> CoreString -> RewriteH CoreProg
progNonRecIntroR nm expr =
do e <- parseCoreExprT expr
guardMsg (not $ isTyCoArg e) "Top-level type or coercion definitions are prohibited."
contextfreeT $ \ prog -> do i <- newIdH nm (exprType e)
return $ ProgCons (NonRec i e) prog
letNonRecIntroR :: String -> CoreString -> RewriteH CoreExpr
letNonRecIntroR nm expr =
do e <- parseCoreExprT expr
contextfreeT $ \ body -> do let tyk = exprKindOrType e
v <- if | isTypeArg e -> newTyVarH nm tyk
| isCoArg e -> newCoVarH nm tyk
| otherwise -> newIdH nm tyk
return $ Let (NonRec v e) body