more sample programs, added strings, added desugar for strings

Grammar.cf

@@ -82,6 +82,7 @@ define infixSymbol e1 vn e3 = EApp (EApp (EVarS (VSymbol vn)) e1) e3;
 
 LInt.  Lit ::= Integer;
 LChar. Lit ::= Char;
+LString. Lit ::= String ;
 
 -------------------------------------------------------------------------------
 -- * AUX

sample-programs/PriorityQueue.crf

@@ -0,0 +1,41 @@
+data Skewheap where
+    Empty : Skewheap
+    Node : Skewheap -> Int -> Skewheap -> Skewheap
+
+data Maybe a where
+    Nothing : Maybe a
+    Just : a -> Maybe a
+
+data Pair a b where
+    Pair : a -> b -> Pair a b
+
+data List a where
+    Nil : List a
+    Cons : a -> List a -> List a
+
+empty = Empty
+
+singleton x = Node Empty x Empty
+
+peek : Skewheap -> Maybe Int
+peek tree = case tree of
+    Node _ x _ => Just x
+    _ => Nothing
+
+pop tree = case tree of
+    Node l x r => Just (Pair x (merge l r))
+    Empty => Nothing 
+
+merge tree1 tree2 = case tree1 of
+    Node left1 val1 right1 => case tree2 of
+        Node left2 val2 right2 => case val1 < val2 of
+            True => Node (merge right1 (Node left2 val2 right2)) val1 left1
+            False => Node (merge right2 (Node left1 val1 right1)) val2 left2
+        _ => tree1
+    Empty => tree2
+
+insert x tree = merge (singleton x) tree
+
+main = case peek (insert 1 (insert 2 (insert 3 (singleton 4)))) of
+    Nothing => (0 - 1)
+    Just x => x

src/Desugar/Desugar.hs

@@ -71,10 +71,14 @@ desugarExp = \case
     EAnn e t                      -> EAnn (desugarExp e) (desugarType t)
     EVarS (VSymbol (Symbol symb)) -> EVar (LIdent $ fixName symb)
     EVarS (VIdent (LIdent ident)) -> EVar $ LIdent $ fixName ident
-    EVar i                        -> EVar i
+    EVar (LIdent i)                        -> EVar (LIdent $ fixName i)
+    ELit (LString str)            -> toList str
     ELit l                        -> ELit l
     EInj i                        -> EInj i
 
+toList :: String -> Exp
+toList = foldr (EApp . EApp (EInj (UIdent "Cons")) . ELit . LChar) (EInj (UIdent "Nil"))
+
 desugarBranch :: Branch -> Branch
 desugarBranch (Branch p e) = Branch (desugarPattern p) (desugarExp e)
 
@@ -89,6 +93,7 @@ desugarPattern = \case
 desugarLit :: Lit -> Lit
 desugarLit (LInt i)  = LInt i
 desugarLit (LChar c) = LChar c
+desugarLit (LString c) = LString c
 
 fixName :: String -> String
 fixName = concatMap mapSymbols

src/Main.hs

@@ -69,7 +69,7 @@ initOpts =
         , debug = False
         , gc = True
         , typechecker = Nothing
-        , preludeOpt = True
+        , preludeOpt = False
         }
 
 enableHelp :: Options -> Options
@@ -97,7 +97,7 @@ data Options = Options
     , debug       :: Bool
     , gc          :: Bool
     , typechecker :: Maybe TypeChecker
-    , preludeOpt     :: Bool
+    , preludeOpt  :: Bool
     }
 
 main' :: Options -> String -> IO ()
@@ -110,7 +110,8 @@ main' opts s =
             file <- readFile s
 
             printToErr "-- Parse Tree -- "
-            parsed <- fromErr . pProgram . resolveLayout True $ myLexer (file ++ prelude)
+            let file' = if opts.preludeOpt then file else file ++ prelude
+            parsed <- fromErr . pProgram . resolveLayout True $ myLexer file'
             log parsed
 
             printToErr "-- Desugar --"