sparsec

commit 8eef46865094ea53e3f7608608eb18440efa8cfd
parent 349fe18411a6c293b1d43bb8b72f28cc00f5e02d
Author: Robert Russell <robert@rr3.xyz>
Date:   Tue, 27 Aug 2024 03:55:11 -0700

Get example apparently working

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

1 file changed, 31 insertions(+), 19 deletions(-)
diff --git a/example/Main.hs b/example/Main.hs
@@ -4,46 +4,52 @@ import Control.Monad
 import Data.ByteString (ByteString)
 import Data.Char
 
+import Debug.Trace -- TODO
+
 import Sparsec
 
 --------------------------------------------------------------------------------
 
-newtype Label = Label ByteString
-newtype Name = Name ByteString
+newtype Label = Label ByteString deriving Show
+newtype Name = Name ByteString deriving Show
 
-data PosNeg = Pos | Neg
-data PrdCns = Prd | Cns
+data PosNeg = Pos | Neg deriving Show
+data PrdCns = Prd | Cns deriving Show
 
 data DeclField
     = DeclFieldType Name
     | DeclFieldTerm PrdCns Type
-data DeclXtor = DeclXtor Label [DeclField]
-data DeclParam = DeclParam Name Kind
-data Decl = Decl PosNeg Name [DeclParam] [DeclXtor]
+    deriving Show
+data DeclXtor = DeclXtor Label [DeclField] deriving Show
+data DeclParam = DeclParam Name Kind deriving Show
+data Decl = Decl PosNeg Name [DeclParam] [DeclXtor] deriving Show
 
 data Kind
     = KindType
     | KindArrow Kind Kind
+    deriving Show
 
 data Type
     = TypeVar Name
     | TypeLam Name Kind Type
     | TypeApp Type Type
+    deriving Show
 
-data Case = Case Label [Name] Stmt
+data Case = Case Label [Name] Stmt deriving Show
 data Term
     = TermVar Name
     | TermMu Name Stmt
     | TermXtor Label [Term]
     | TermMatch [Case]
+    deriving Show
 
-data Stmt = StmtCut Term Type Term
+data Stmt = StmtCut Term Type Term deriving Show
 
-data Prog = Prog [Decl] Stmt
+data Prog = Prog [Decl] Stmt deriving Show
 
 --------------------------------------------------------------------------------
 
-data Err = ErrUtf8 Loc | Err
+data Err = ErrUtf8 Loc | Err deriving Show -- TODO
 
 instance Utf8Error Err where
     utf8Error = ErrUtf8
@@ -59,9 +65,10 @@ isKw s = s == "pos" || s == "neg" || s == "prd" || s == "cns"
 pWs = charWhile isSpace
 pToken p = p <* pWs
 pSym = pToken . string
-pBreak = notp $ charIf isWordCont
-pKw s = pSym s <* pBreak
-pWord = bytesOf $ charIf isWordStart *> charWhile isWordCont
+pWord = snd <$> (bytesOf $ charIf isWordStart *> charWhile isWordCont)
+pKw s = do
+    s' <- pToken pWord
+    guard (s' == s)
 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 ","
@@ -77,10 +84,10 @@ pPrdCns = pKw "prd" *> pure Prd <|> pKw "cns" *> pure Cns
 
 pDeclField :: Int -> P DeclField
 pDeclField = \case
-    0 -> DeclFieldTerm <$> (pPrdCns <|> pure Prd) <*> pType 1
-    1 -> DeclFieldTerm Prd <$> pType 2
-        <|> pSym "$" *> (DeclFieldType <$> pName) `cut` Err
+    0 -> DeclFieldTerm <$> (pPrdCns <|> pure Prd) <*> pType 0 <|> pDeclField 1
+    1 -> pSym "$" *> (DeclFieldType <$> pName) `cut` Err
         <|> pDelim "(" (pDeclField 0) ")"
+        <|> DeclFieldTerm Prd <$> pTypeAtom
 
 pDeclXtor = DeclXtor <$> pLabel <*> many (pDeclField 1)
 
@@ -115,11 +122,13 @@ pTypeLam = do
     body <- pType 0 `cut` Err
     pure $ TypeLam x k body
 
+pTypeAtom = TypeVar <$> pName
+
 pType :: Int -> P Type
 pType = \case
     0 -> pTypeLam <|> pType 1
     1 -> pType 2 >>= iter \a -> TypeApp a <$> pType 2
-    2 -> TypeVar <$> pName <|> pDelim "(" (pType 0) ")"
+    2 -> pTypeAtom <|> pDelim "(" (pType 0) ")"
 
 pCase = do
     l <- pLabel
@@ -162,5 +171,8 @@ pSrc = pWs *> pProg <* eof
     
 --------------------------------------------------------------------------------
 
+ex :: ByteString
+ex = "pos Bool { #true, #false } pos Any { #any $A A, } [#true :Bool: #false]"
+
 main :: IO ()
-main = putStrLn "whoa"
+main = print $ runParse pSrc ex locZero