From 243f4f5b58014159be0c4dd7b0fc5c0a8021fd3c Mon Sep 17 00:00:00 2001
From: Tom Smeding <tom.smeding@gmail.com>
Date: Sat, 23 May 2020 11:40:06 +0200
Subject: Don't parse Constructors as variables

---
 src/Haskell/AST.hs     | 3 +++
 src/Haskell/Parser.hs  | 3 ++-
 src/Haskell/Rewrite.hs | 5 ++++-
 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)
-- 
cgit v1.2.3