quasiquoters

src/Core/Parse.y

@@ -4,6 +4,9 @@ module Core.Parse
     , parseCoreExpr
     , module Core.Lex -- temp convenience
     , parseTmp
+    , SrcError
+    , ParseError
+    , Module
     )
     where
 
@@ -15,7 +18,7 @@ import Compiler.RLPC
 }
 
 %name parseCore Module
-%name parseCoreExpr Expr
+%name parseCoreExpr StandaloneExpr
 %tokentype { Located CoreToken }
 %error { parseError }
 %monad { RLPC ParseError }
@@ -75,6 +78,9 @@ ParList         :: { [Name] }
 ParList         : Var ParList                   { $1 : $2 }
                 | {- epsilon -}                 { [] }
 
+StandaloneExpr  :: { Expr }
+StandaloneExpr  : Expr eof                      { $1 }
+
 Expr            :: { Expr }
 Expr            : LetExpr                       { $1 }
                 | 'λ' Binders '->' Expr         { Lam $2 $4 }
@@ -141,5 +147,6 @@ parseTmp = do
         Right (ts,_) -> pure ts
     where
         parse = evalRLPC RLPCOptions . (lexCore >=> parseCore)
+
 }
 

src/Core/TH.hs

@@ -5,8 +5,10 @@ module Core.TH
     where
 ----------------------------------------------------------------------------------
 import Language.Haskell.TH
-import Language.Haskell.TH.Syntax
+import Language.Haskell.TH.Syntax hiding (Module)
 import Language.Haskell.TH.Quote
+import Control.Monad                ((>=>))
+import Compiler.RLPC
 import Core.Parse
 import Core.Lex
 ----------------------------------------------------------------------------------
@@ -27,16 +29,17 @@ coreExpr = QuasiQuoter
     , quoteDec = error "core quasiquotes may only be used in expressions"
     }
 
-qCore = undefined
-qCoreExpr = undefined
+qCore :: String -> Q Exp
+qCore s = case parse s of
+    Left e       -> error (show e)
+    Right (m,ts) -> lift m
+    where
+        parse = evalRLPC RLPCOptions . (lexCore >=> parseCore)
 
--- qCore :: String -> Q Exp
--- qCore s = case lexCore s >>= parseCore of
---     Success a -> lift a
---     Error e _ _ -> error e
-
--- qCoreExpr :: String -> Q Exp
--- qCoreExpr s = case lexCore s >>= parseCoreExpr of
---     Success a -> lift a
---     Error e _ _ -> error e
+qCoreExpr :: String -> Q Exp
+qCoreExpr s = case parseExpr s of
+    Left e       -> error (show e)
+    Right (m,ts) -> lift m
+    where
+        parseExpr = evalRLPC RLPCOptions . (lexCore >=> parseCoreExpr)