aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorTom Smeding <tom.smeding@gmail.com>2020-05-23 11:40:06 +0200
committerTom Smeding <tom.smeding@gmail.com>2020-05-23 11:40:06 +0200
commit243f4f5b58014159be0c4dd7b0fc5c0a8021fd3c (patch)
tree18b2040043382fa4ca3f6615047b3e446812678c
parentf85f5515486504c9c3401332269a0dda20c96f1d (diff)
Don't parse Constructors as variables
-rw-r--r--src/Haskell/AST.hs3
-rw-r--r--src/Haskell/Parser.hs3
-rw-r--r--src/Haskell/Rewrite.hs5
3 files changed, 9 insertions, 2 deletions
diff --git a/src/Haskell/AST.hs b/src/Haskell/AST.hs
index f8b5c72..072fd97 100644
--- a/src/Haskell/AST.hs
+++ b/src/Haskell/AST.hs
@@ -22,6 +22,7 @@ data Def = Def Name Expr
data Expr = App Expr [Expr]
| Ref Name
+ | Con Name
| Num Integer
| Tup [Expr]
| Lam [Name] Expr
@@ -71,6 +72,7 @@ instance Pretty Def where
instance Pretty Expr where
pretty (App e as) = Bracket "(" ")" "" (map pretty (e:as))
pretty (Ref n) = Leaf n
+ pretty (Con n) = Leaf n
pretty (Num n) = Leaf (show n)
pretty (Tup es) = Bracket "(" ")" "," (map pretty es)
pretty (Lam as e) = Bracket "(" ")" "" [Node ("\\" ++ intercalate " " as ++ " ->") [pretty e]]
@@ -124,6 +126,7 @@ instance AllRefs Def where
instance AllRefs Expr where
allRefs (App e es) = nub $ concatMap allRefs (e : es)
allRefs (Ref n) = [n]
+ allVars (Con _) = []
allRefs (Num _) = []
allRefs (Tup es) = nub $ concatMap allRefs es
allRefs (Lam ns e) = allRefs e \\ ns
diff --git a/src/Haskell/Parser.hs b/src/Haskell/Parser.hs
index bd10705..9ebf2af 100644
--- a/src/Haskell/Parser.hs
+++ b/src/Haskell/Parser.hs
@@ -36,6 +36,7 @@ pExpr = pLam <|> pCase <|> pApp
where
pSimpleExpr = choice [Num <$> pNum
,Ref <$> pVariable
+ ,Con <$> pNameT
,parens (pExpr `sepBy` symbolO ",") >>= \case
[ex] -> return ex
exs -> return $ Tup exs]
@@ -82,7 +83,7 @@ pNum = (char '-' >> (negate <$> pPositive)) <|> pPositive
where pPositive = read <$> many1 digit <* aheadW
pVariable :: Parser Name
-pVariable = pName <|> try (parens pOperator)
+pVariable = pNameV <|> try (parens pOperator)
pName :: Parser Name
pName = notReserved $ liftM2 (:) (satisfy isAlpha) pNameRest
diff --git a/src/Haskell/Rewrite.hs b/src/Haskell/Rewrite.hs
index 7eaadea..498ccae 100644
--- a/src/Haskell/Rewrite.hs
+++ b/src/Haskell/Rewrite.hs
@@ -79,8 +79,10 @@ unify :: Pat -> Expr -> Maybe (Map.Map Name Expr)
unify PatAny _ = Just Map.empty
unify (PatVar n) e = Just (Map.singleton n e)
unify (PatCon n ps) (App n' es)
- | n' == Ref n, length ps == length es =
+ | n' == Con n, length ps == length es =
foldM (\m (p, e) -> unify p e >>= reconcile m) Map.empty (zip ps es)
+unify (PatCon n []) (Con n')
+ | n == n' = Just Map.empty
unify (PatTup ps) (Tup es)
| length ps == length es =
foldM (\m (p, e) -> unify p e >>= reconcile m) Map.empty (zip ps es)
@@ -101,6 +103,7 @@ normalise e = recurse id normalise e
recurse :: (Pat -> Pat) -> (Expr -> Expr) -> Expr -> Expr
recurse _ f (App e as) = App (f e) (map f as)
recurse _ _ (Ref n) = Ref n
+recurse _ _ (Con n) = Con n
recurse _ _ (Num k) = Num k
recurse _ f (Tup es) = Tup (map f es)
recurse _ f (Lam ns e) = Lam ns (f e)