Add list literal syntax (#119)

* Broken List Parser

* fix to main

* Small chagnes to pattern match ListExpr

* Todo add list with element implentation to Scope

* Looping through elements of ListExpr in scope

* Add todo message to LowerAst

* compiler.unexpected in lowerAst

* fix warnings and failing regression test

* fix desugarExpr case, add newlines

* remove unnecessary file

* DesugarLists partial implementation

* add dev hints

* Desugaring Lists progress, no longer using foldapp

* desugar lists with errors

* Bypass matching on diff Exprs

* Test cases passing

* Added more meaningful tests to lists_sample

* Fix warnings and style nits

* fix imports

Co-authored-by: EmilySillars <[email protected]>

regression-tests/tests/lists_sample.out

@@ -0,0 +1,3 @@
+1 2 3
+1
+

regression-tests/tests/lists_sample.ssl

@@ -0,0 +1,34 @@
+type List
+  Cons Int List
+  Nil
+
+puts cout s =
+  match s
+    Cons c ss =
+      after 1, cout <- c
+      wait cout
+      after 1, cout <- 32
+      wait cout
+      puts cout ss
+    Nil = ()
+
+main cin cout =
+// check multi element list
+  let multi_lst = [49,50,51]
+  puts cout multi_lst
+  after 1, cout <- 10
+  wait cout
+
+// check singleton list
+  let single_lst = [49]
+  puts cout single_lst
+
+  after 1, cout <- 10
+  wait cout
+
+// check empty element list
+  let empty_lst = []
+  puts cout empty_lst
+
+  after 1, cout <- 10
+  wait cout

regression-tests/tests/lists_sample2.out

@@ -0,0 +1 @@
+1 2 3 4 5

regression-tests/tests/lists_sample2.ssl

@@ -0,0 +1,20 @@
+// Checking if list ADTs work as intended
+// Tests underlying construction of lists
+
+type List
+  Cons Int List
+  Nil
+
+puts cout s =
+  match s
+    Cons c ss =
+      after 1, cout <- c
+      wait cout
+      after 1, cout <- 32
+      wait cout
+      puts cout ss
+    Nil = ()
+
+main cin cout =
+ let lst = Cons 49 (Cons 50 (Cons 51 (Cons 52 (Cons 53 Nil))))
+ puts cout lst

src/Common/Identifiers.hs

@@ -62,6 +62,8 @@ module Common.Identifiers
   , ungenId
   , tuple
   , tempTuple
+  , cons
+  , nil
   ) where
 
 import           Common.Pretty                  ( Pretty(..) )
@@ -286,4 +288,12 @@ tuple = Identifier "(,)"
 
 -- | we'll use this temp tuple name for now due to the naming issue
 tempTuple :: Identifier
-tempTuple = Identifier "Pair"
+tempTuple = Identifier "Pair"
+
+-- | Cons identifier for Lists
+cons :: Identifier
+cons = Identifier "Cons"
+
+-- | Nil identifier for Lists
+nil :: Identifier
+nil = Identifier "Nil"

src/Front/DesugarLists.hs

@@ -4,7 +4,7 @@ module Front.DesugarLists
   ) where
 
 import qualified Common.Compiler               as Compiler
-import Common.Identifiers                       (Identifier(Identifier))
+import Common.Identifiers
 import Front.Ast                                ( Definition(..)
                                                 , Expr(..)
                                                 , Program(..)
@@ -14,23 +14,21 @@ import Data.Generics                            ( mkT, everywhere )
 
 -- | Desugar ListExpr nodes inside of an AST 'Program'.
 desugarLists :: Program -> Compiler.Pass Program
-desugarLists (Program decls) = return $ Program $ desugarTop <$> decls
- where
-  desugarTop (TopDef d) = TopDef $ desugarDef d
-  desugarTop t          = t
+desugarLists (Program decls) = return $ Program $ desugarTop <$> decls 
+  where
+    desugarTop (TopDef d) = TopDef $ desugarDef d
+    desugarTop t = t
+    desugarDef (DefFn v bs t e) = DefFn v bs t $ everywhere (mkT desugarExpr) e
+    desugarDef (DefPat b e    ) = DefPat b $ everywhere (mkT desugarExpr) e
 
-  desugarDef (DefFn v bs t e) = DefFn v bs t $ everywhere (mkT desugarExpr) e
-  desugarDef (DefPat b e    ) = DefPat b $ everywhere (mkT desugarExpr) e
-
--- | Transform a node of type ListExpr into a node of type App 
+-- | Transform a node of type ListExpr into a node of type App
 -- For ex, (ListExpr [1, 2, 3]) turns into
--- App (App (Id "Cons") (Lit (LitInt 1) )) 
---     (App (App (Id "Cons") (Lit (LitInt 2))) 
+-- App (App (Id "Cons") (Lit (LitInt 1) ))
+--     (App (App (Id "Cons") (Lit (LitInt 2)))
 --          (App (App (Id "Cons") (Lit (LitInt 3))) (id "Nil")))
 desugarExpr :: Expr -> Expr
-desugarExpr (ListExpr es) = func es
-desugarExpr e = e 
-
-func :: [Expr] -> Expr
-func [] = Id (Identifier "Nil")
-func t = foldr (Apply . Apply (Id (Identifier "Cons"))) (Id (Identifier "Nil")) t
+desugarExpr (ListExpr es) = helper es
+  where helper :: [Expr] -> Expr
+        helper [] = (Id nil)
+        helper (h:t) = Apply (Apply (Id cons) h) (helper t)
+desugarExpr e = e

src/Front/Parser.y

@@ -314,8 +314,18 @@ exprAtom
   | id                                  { Id $1 }
   | '(' expr ')'                        { $2 }
   | '(' ')'                             { Lit LitEvent }
+  | '[' exprList ']'                    { ListExpr $2 }
   | '(' expr ',' exprTups ')'           { Tuple ($2 : $4)  }
 
+-- | List Expression.
+exprList
+  :list                                 { $1 }
+  | {- empty list -}                    { [] }
+
+list
+  :exprAtom                             { [$1] }
+  | exprAtom ',' list                   { $1 : $3 }
+
 -- | Pipe-separated expressions, for parallel composition.
 exprPar                               --> [Expr]
   : expr '||' exprPar                   { $1 : $3 }

src/Front/Pattern/Anomaly.hs

@@ -99,7 +99,6 @@ checkExprs = mapM_ checkExpr
 checkExpr :: A.Expr -> AnomalyFn ()
 checkExpr (A.Id       _          ) = return ()
 checkExpr (A.Lit      _          ) = return ()
-checkExpr (A.ListExpr es         ) = checkExprs es
 checkExpr (A.Apply    e1 e2      ) = checkExprs [e1, e2]
 checkExpr (A.Lambda   _  e       ) = checkExpr e -- WARN: patterns here are not checked
 checkExpr (A.OpRegion e  opRegion) = checkExpr e >> checkOpRegion opRegion
@@ -119,6 +118,7 @@ checkExpr (A.Match e arms) =
   let (ps, es) = unzip arms in checkExpr e >> checkExprs es >> checkPats ps
 checkExpr (A.CQuote _  ) = return ()
 checkExpr (A.CCall _ es) = mapM_ checkExpr es
+checkExpr (A.ListExpr es)    = mapM_ checkExpr es
 checkExpr (A.Tuple es        )     = checkExprs es
 
 checkOpRegion :: A.OpRegion -> AnomalyFn ()