sparsec

commit 7ba40ebc9640541cba8b29eab8ee5358c67ba09f
parent d36364d4a6bb0c0536a46aec545a16701c9905ec
Author: Robert Russell <robert@rr3.xyz>
Date:   Tue, 27 Aug 2024 15:06:31 -0700

Distinguish TypeNames and TermNames

Diffstat:
M
example/Main.hs
 | 
55
++++++++++++++++++++++++++++---------------------------

1 file changed, 28 insertions(+), 27 deletions(-)
diff --git a/example/Main.hs b/example/Main.hs
@@ -12,16 +12,17 @@ import Sparsec
 -- Surface syntax
 
 newtype XtorName = XtorName ByteString deriving (Show, Eq, Ord)
-newtype VarName = VarName ByteString deriving (Show, Eq, Ord)
-newtype CmdName = CmdName ByteString deriving (Show, Eq, Ord)
+newtype TypeName = TypeName ByteString deriving (Show, Eq, Ord)
+newtype TermName = TermName ByteString deriving (Show, Eq, Ord)
+newtype StmtName = StmtName ByteString deriving (Show, Eq, Ord)
 
 data PosNeg = Pos | Neg deriving Show
 data PrdCns = Prd | Cns deriving Show
 
-data DeclParam = DeclParam VarName Kind deriving Show
+data DeclParam = DeclParam TypeName Kind deriving Show
 data DeclField = DeclField PrdCns Type deriving Show
 data DeclXtor = DeclXtor XtorName [DeclParam] [DeclField] deriving Show
-data Decl = Decl PosNeg VarName [DeclParam] [DeclXtor] deriving Show
+data Decl = Decl PosNeg TypeName [DeclParam] [DeclXtor] deriving Show
 
 data Kind
     = KindType PosNeg
@@ -29,22 +30,22 @@ data Kind
     deriving Show
 
 data Type
-    = TypeVar VarName
-    | TypeLam VarName (Maybe Kind) Type
+    = TypeVar TypeName
+    | TypeLam TypeName (Maybe Kind) Type
     | TypeApp Type Type
     deriving Show
 
-data Case = Case XtorName [VarName] Stmt deriving Show
+data Case = Case XtorName [TermName] Stmt deriving Show
 data Term
-    = TermVar VarName
-    | TermMu VarName (Maybe Type) Stmt
+    = TermVar TermName
+    | TermMu TermName (Maybe Type) Stmt
     | TermXtor XtorName [Type] [Term]
     | TermMatch [Case]
     deriving Show
 
 data Stmt
     = StmtCut Term Type Term -- TODO: Should Cut be a special case of Cmd?
-    | StmtCmd CmdName [Type] [Term]
+    | StmtCmd StmtName [Type] [Term]
     deriving Show
 
 data Prog = Prog [Decl] Stmt deriving Show
@@ -72,26 +73,26 @@ pWord = snd <$> (bytesOf $ charIf isWordStart *> charWhile isWordCont)
 pKw s = do
     s' <- pToken pWord
     guard (s' == s)
+pIdent = do
+    x <- pToken pWord
+    guard $ not $ isKw x
+    pure x
 pDelim l p r = pSym l *> (p <* pSym r) `cut` Err
 pManySepByWithTrailer p sep = p `someSepBy` sep <* opt sep <|> pure []
 pList p = p `pManySepByWithTrailer` pSym ","
 
 pXtorName = XtorName <$> pToken (char '#' *> pWord `cut` Err)
-
-pVarName = do
-    x <- pToken pWord
-    guard $ not $ isKw x
-    pure $ VarName x
-
-pCmdName = CmdName <$> pToken (char '@' *> pWord `cut` Err)
+pTypeName = TypeName <$> pIdent
+pTermName = TermName <$> pIdent
+pStmtName = StmtName <$> pToken (char '@' *> pWord `cut` Err)
 
 pPosNeg = pSym "+" *> pure Pos <|> pSym "-" *> pure Neg
 pPrdCns = pKw "prd" *> pure Prd <|> pKw "cns" *> pure Cns
 
 pDeclParam :: Int -> P DeclParam
 pDeclParam = \case
-    0 -> DeclParam <$> pVarName <*> branch (pSym ":") (pKind 0 `cut` Err) (pure $ KindType Pos)
-    1 -> DeclParam <$> pVarName <*> pure (KindType Pos) <|> pDelim "(" (pDeclParam 0) ")"
+    0 -> DeclParam <$> pTypeName <*> branch (pSym ":") (pKind 0 `cut` Err) (pure $ KindType Pos)
+    1 -> DeclParam <$> pTypeName <*> pure (KindType Pos) <|> pDelim "(" (pDeclParam 0) ")"
 
 pDeclField :: Int -> P DeclField
 pDeclField = \case
@@ -106,7 +107,7 @@ pDeclXtor = do
 
 pDecl = do
     pKw "data"
-    x <- pVarName
+    x <- pTypeName
     params <- many (pDeclParam 1)
     posneg <- branch (pSym ":") (pPosNeg `cut` Err) (pure Pos)
     xtors <- pDelim "{" (pList pDeclXtor) "}"
@@ -123,13 +124,13 @@ pKind = \case
 
 pTypeLam = do
     pSym "\\"
-    x <- pVarName `cut` Err
+    x <- pTypeName `cut` Err
     mk <- opt (pSym ":" *> pKind 0 `cut` Err)
     pSym "=>" `cut` Err
     body <- pType 0 `cut` Err
     pure $ TypeLam x mk body
 
-pTypeAtom = TypeVar <$> pVarName
+pTypeAtom = TypeVar <$> pTypeName
 
 pType :: Int -> P Type
 pType = \case
@@ -139,14 +140,14 @@ pType = \case
 
 pCase = do
     x <- pXtorName
-    vars <- many pVarName
+    vars <- many pTermName
     pSym "=>" `cut` Err
     body <- pStmt `cut` Err
     pure $ Case x vars body
 
 pTermMu = do
     pSym "\\"
-    x <- pVarName `cut` Err
+    x <- pTermName `cut` Err
     ma <- opt (pSym ":" *> pType 1 `cut` Err)
     pSym "=>" `cut` Err
     body <- pStmt `cut` Err
@@ -168,12 +169,12 @@ pTerm :: Int -> P Term
 pTerm = \case
     0 -> pTermMu <|> pTerm 1
     1 -> pTermXtor <|> pTerm 2
-    2 -> TermVar <$> pVarName
+    2 -> TermVar <$> pTermName
         <|> TermMatch <$> pDelim "{" (pList pCase) "}"
         <|> pDelim "(" (pTerm 0) ")"
 
 pStmtCmd = do
-    x <- pCmdName
+    x <- pStmtName
     (tyArgs, tmArgs) <- args
     pure $ StmtCmd x tyArgs tmArgs
 
@@ -219,7 +220,7 @@ elabProg (Prog decls stmt) =
 --------------------------------------------------------------------------------
 
 ex :: ByteString
-ex = "data Bool { #true, #false } data Any { #any [A] A, } #true :Bool: \\x=>@print"
+ex = "data Bool : + { #true, #false } data Any { #any [A] A, } #true :Bool: \\x=>@print"
 
 main :: IO ()
 main = print $ runParse pSrc ex locZero