aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--AST.hs16
-rw-r--r--Parser.hs12
-rw-r--r--hs-visinter.cabal1
3 files changed, 17 insertions, 12 deletions
diff --git a/AST.hs b/AST.hs
index cae9ecb..2e1bb13 100644
--- a/AST.hs
+++ b/AST.hs
@@ -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)
diff --git a/Parser.hs b/Parser.hs
index 27f4f59..c958069 100644
--- a/Parser.hs
+++ b/Parser.hs
@@ -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