diff --git a/rlp.cabal b/rlp.cabal index e25a5ab..d1d2d71 100644 --- a/rlp.cabal +++ b/rlp.cabal @@ -26,12 +26,14 @@ library , Core.Syntax , Core.Parse , Core.Lex + , Core.TH -- other-extensions: build-depends: base ^>=4.18.0.0 , containers , microlens , microlens-th + , template-haskell hs-source-dirs: src default-language: GHC2021 diff --git a/src/Control/Parser.hs b/src/Control/Parser.hs index 332aeaf..b1b2caa 100644 --- a/src/Control/Parser.hs +++ b/src/Control/Parser.hs @@ -62,6 +62,11 @@ instance (MonadFail m) => MonadFail (ParserT i m) where ---------------------------------------------------------------------------------- +eof :: (MonadPlus m) => ParserT [a] m () +eof = ParserT $ \case + [] -> pure ([], ()) + _ -> empty + -- TODO: generalise to non-lists satisfy :: (MonadPlus m) => (a -> Bool) -> ParserT [a] m a satisfy p = ParserT $ \case diff --git a/src/Core/Parse.hs b/src/Core/Parse.hs index b9f4576..8cb9497 100644 --- a/src/Core/Parse.hs +++ b/src/Core/Parse.hs @@ -1,6 +1,7 @@ {-# LANGUAGE LambdaCase, BlockArguments #-} module Core.Parse ( parseCore + , parseCoreExpr ) where ---------------------------------------------------------------------------------- @@ -15,6 +16,9 @@ type CoreParser = ParserT [CoreToken] Result parseCore :: [CoreToken] -> Result Program parseCore = fmap snd . runParserT program +parseCoreExpr :: [CoreToken] -> Result Expr +parseCoreExpr = fmap snd . runParserT expr + program :: CoreParser Program program = Program <$> termMany (char TokSemicolon) scdef diff --git a/src/Core/Syntax.hs b/src/Core/Syntax.hs index 46c9c8e..b08bf1d 100644 --- a/src/Core/Syntax.hs +++ b/src/Core/Syntax.hs @@ -18,9 +18,10 @@ module Core.Syntax ---------------------------------------------------------------------------------- import Data.Coerce import Data.Pretty -import Data.List (intersperse) -import Data.Function ((&)) +import Data.List (intersperse) +import Data.Function ((&)) import Data.String +import Language.Haskell.TH.Syntax (Lift) ---------------------------------------------------------------------------------- data Expr = Var Name @@ -30,14 +31,14 @@ data Expr = Var Name | Lam [Name] Expr | App Expr Expr | IntE Int - deriving Show + deriving (Show, Lift) infixl 2 :$ pattern (:$) :: Expr -> Expr -> Expr pattern f :$ x = App f x data Binding = Binding Name Expr - deriving Show + deriving (Show, Lift) infixl 1 := pattern (:=) :: Name -> Expr -> Binding @@ -45,18 +46,18 @@ pattern k := v = Binding k v data Rec = Rec | NonRec - deriving (Show, Eq) + deriving (Show, Eq, Lift) data Alter = Alter Int [Name] Expr - deriving Show + deriving (Show, Lift) type Name = String data ScDef = ScDef Name [Name] Expr - deriving (Show) + deriving (Show, Lift) newtype Program = Program [ScDef] - deriving (Show) + deriving (Show, Lift) instance IsString Expr where fromString = Var diff --git a/src/Core/TH.hs b/src/Core/TH.hs new file mode 100644 index 0000000..f455bb1 --- /dev/null +++ b/src/Core/TH.hs @@ -0,0 +1,39 @@ +module Core.TH + ( coreExpr + , core + ) + where +---------------------------------------------------------------------------------- +import Language.Haskell.TH +import Language.Haskell.TH.Syntax +import Language.Haskell.TH.Quote +import Core.Parse +import Core.Lex +---------------------------------------------------------------------------------- + +core :: QuasiQuoter +core = QuasiQuoter + { quoteExp = qCore + , quotePat = error "core quasiquotes may only be used in expressions" + , quoteType = error "core quasiquotes may only be used in expressions" + , quoteDec = error "core quasiquotes may only be used in expressions" + } + +coreExpr :: QuasiQuoter +coreExpr = QuasiQuoter + { quoteExp = qCoreExpr + , quotePat = error "core quasiquotes may only be used in expressions" + , quoteType = error "core quasiquotes may only be used in expressions" + , quoteDec = error "core quasiquotes may only be used in expressions" + } + +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 +