diff options
| -rw-r--r-- | AST.hs | 16 | ||||
| -rw-r--r-- | Parser.hs | 12 | ||||
| -rw-r--r-- | hs-visinter.cabal | 1 |
3 files changed, 17 insertions, 12 deletions
@@ -1,14 +1,19 @@ module AST where +import Data.List.NonEmpty (NonEmpty) + + +newtype Name = Name String + deriving (Show, Eq) data Program t = Program [FunDef t] deriving (Show) -data FunDef t = FunDef Name (Maybe Type) [FunEq t] +data FunDef t = FunDef Name (Maybe Type) (NonEmpty (FunEq t)) deriving (Show) -newtype Name = Name String - deriving (Show, Eq) +data FunEq t = FunEq Name [Pattern t] (RHS t) + deriving (Show) data Type = TApp Type [Type] @@ -19,9 +24,6 @@ data Type | TVar Name deriving (Show) -data FunEq t = FunEq Name [Pattern t] (RHS t) - deriving (Show) - data Pattern t = PWildcard t | PVar t Name @@ -32,7 +34,7 @@ data Pattern t deriving (Show) data RHS t - = Guarded [(Expr t, Expr t)] + = Guarded [(Expr t, Expr t)] -- currently not parsed | Plain (Expr t) deriving (Show) @@ -21,6 +21,7 @@ import Control.Monad.Reader import Control.Monad.State.Lazy import Data.Bifunctor (first) import Data.Char +import Data.List.NonEmpty (NonEmpty(..)) import Data.These import Data.Tuple (swap) @@ -141,11 +142,11 @@ pFunDef0 = do (clauses, name) <- someClauses mname return (FunDef name mtype clauses) where - someClauses :: Maybe Name -> Parser ([FunEq ()], Name) + someClauses :: Maybe Name -> Parser (NonEmpty (FunEq ()), Name) someClauses Nothing = do clause@(FunEq name _ _) <- pFunEq Nothing - (,name) . (clause:) <$> many (pFunEq (Just name)) - someClauses (Just name) = (,name) <$> some (pFunEq (Just name)) + (,name) . (clause :|) <$> many (pFunEq (Just name)) + someClauses (Just name) = (,name) <$> someNE (pFunEq (Just name)) -- | Given the name of the type signature, if any. pFunEq :: Maybe Name -> Parser (FunEq ()) @@ -724,7 +725,7 @@ satisfy p = do traceM "got rest" r `seq` return () traceM "seqd rest" - traceM ("rest is " ++ r) + traceM ("rest is " ++ show r) case r of c : rest | c /= '\n', p c -> do modify (\ps -> ps { psCol = psCol ps + 1 @@ -772,3 +773,6 @@ whenM mb mx = mb >>= \b -> if b then mx else return mempty optional_ :: Alternative f => f a -> f () optional_ a = (() <$ a) <|> pure () + +someNE :: Alternative f => f a -> f (NonEmpty a) +someNE a = (:|) <$> a <*> many a diff --git a/hs-visinter.cabal b/hs-visinter.cabal index 7bc98d1..1972b77 100644 --- a/hs-visinter.cabal +++ b/hs-visinter.cabal @@ -15,7 +15,6 @@ executable hs-visinter build-depends: base >= 4.16 && < 4.19, containers >= 0.6.3.1 && < 0.7, - parsec >= 3.1.14.0 && < 3.2, mtl, monad-chronicle ^>= 1.0.0.1, these |