diff --git a/rlp.cabal b/rlp.cabal index c5c699d..38988af 100644 --- a/rlp.cabal +++ b/rlp.cabal @@ -27,6 +27,8 @@ library , Core.TH , Core.Examples , Core.Lex + , Compiler.RLPC + , Control.Monad.Errorful build-tool-depends: happy:happy, alex:alex diff --git a/src/Core/Parse.y b/src/Core/Parse.y index 05e8d7e..83f844d 100644 --- a/src/Core/Parse.y +++ b/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) + } diff --git a/src/Core/TH.hs b/src/Core/TH.hs index d700275..8330867 100644 --- a/src/Core/TH.hs +++ b/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)