diff --git a/regression-tests/tests/lists_sample.out b/regression-tests/tests/lists_sample.out new file mode 100644 index 00000000..3cf97b0e --- /dev/null +++ b/regression-tests/tests/lists_sample.out @@ -0,0 +1,3 @@ +1 2 3 +1 + diff --git a/regression-tests/tests/lists_sample.ssl b/regression-tests/tests/lists_sample.ssl new file mode 100644 index 00000000..9900e8f6 --- /dev/null +++ b/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 diff --git a/regression-tests/tests/lists_sample2.out b/regression-tests/tests/lists_sample2.out new file mode 100644 index 00000000..aacb5952 --- /dev/null +++ b/regression-tests/tests/lists_sample2.out @@ -0,0 +1 @@ +1 2 3 4 5 diff --git a/regression-tests/tests/lists_sample2.ssl b/regression-tests/tests/lists_sample2.ssl new file mode 100644 index 00000000..d914abcf --- /dev/null +++ b/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 diff --git a/src/Common/Identifiers.hs b/src/Common/Identifiers.hs index 96996e1d..62d096f3 100644 --- a/src/Common/Identifiers.hs +++ b/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" \ No newline at end of file +tempTuple = Identifier "Pair" + +-- | Cons identifier for Lists +cons :: Identifier +cons = Identifier "Cons" + +-- | Nil identifier for Lists +nil :: Identifier +nil = Identifier "Nil" diff --git a/src/Front/DesugarLists.hs b/src/Front/DesugarLists.hs index 50e8b9d6..5d5cff3c 100644 --- a/src/Front/DesugarLists.hs +++ b/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 diff --git a/src/Front/Parser.y b/src/Front/Parser.y index 9b6ac25e..7372b894 100644 --- a/src/Front/Parser.y +++ b/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 } diff --git a/src/Front/Pattern/Anomaly.hs b/src/Front/Pattern/Anomaly.hs index 59b7c7e2..5d3dd47b 100644 --- a/src/Front/Pattern/Anomaly.hs +++ b/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 ()