Level Order Traversal demo

Additionally sorts gitignore and adds attempted decoding of lists back
to the REPL

.gitignore

@@ -1,11 +1,11 @@
-bin/
-/result
-/config.dhall
-/Dockerfile
-.stack-work/
 *.swp
-dist*
+*.txt
 *~
 .env
+.stack-work/
+/Dockerfile
+/config.dhall
+/result
 WD
-*.hs.txt
+bin/
+dist*

demos/LevelOrderTraversal.tri

@@ -0,0 +1,34 @@
+-- Level Order Traversal of a labelled binary tree
+-- Objective: Print each "level" of the tree on a separate line
+--
+-- NOTICE: This demo relies on tricu base library functions
+-- 
+-- We model labelled binary trees as sublists where values act as labels. We
+-- require explicit notation of empty nodes. Empty nodes can be represented 
+-- with an empty list, `[]`, which is equivalent to a single node `t`. 
+--
+-- Example tree inputs:
+-- [("1") [("2") [("4") t t] t] [("3") [("5") t t] [("6") t t]]]]
+-- Graph:
+--       1
+--      / \
+--     2   3
+--    /   /  \
+--   4   5    6
+--
+
+isLeaf = (\node : lOr (emptyList node) (emptyList (tail node)))
+getLabel = (\node : head node)
+getLeft = (\node : if (emptyList node) [] (if (emptyList (tail node)) [] (head (tail node))))
+getRight = (\node : if (emptyList node) [] (if (emptyList (tail node)) [] (if (emptyList (tail (tail node))) [] (head (tail (tail node))))))
+
+processLevel = y (\self queue : if (emptyList queue) [] (pair (map getLabel queue) (self (filter (\node : not (emptyList node)) (lconcat (map getLeft queue) (map getRight queue))))))
+levelOrderTraversal = (\a : processLevel (t a t))
+toLineString = y (\self levels : if (emptyList levels) "" (lconcat (lconcat (map (\x : lconcat x " ") (head levels)) "") (if (emptyList (tail levels)) "" (lconcat (t (t 10 t) t) (self (tail levels))))))
+levelOrderToString = (\s : toLineString (levelOrderTraversal s))
+
+flatten = foldl (\acc x : lconcat acc x) ""
+flatLOT = (\s : lconcat (t 10 t) (flatten (levelOrderToString s)))
+
+exampleOne = flatLOT [("1") [("2") [("4") t t] t] [("3") [("5") t t] [("6") t t]]]]
+exampleTwo = flatLOT [("1") [("2") [("4") [("8") t t] [("9") t t]] [("6") [("10") t t] [("12") t t]]] [("3") [("5") [("11") t t] t] [("7") t t]]]

lib/base.tri

@@ -33,3 +33,9 @@ lOr = triage (\x : x) (\_ _ : true) (\_ _ x : true)
 hmap = y (\self : matchList (\f : t) (\hd tl f : pair (f hd) (self tl f)))
 map = (\f l : hmap l f)
 equal = y (\self : triage (triage true (\z : false) (\y z : false)) (\ax : triage false (self ax) (\y z : false)) (\ax ay : triage false (\z : false) (\bx by : lAnd (self ax bx) (self ay by))))
+hfilter = y (\self : matchList (\f : t) (\hd tl f : matchBool (t hd) i (f hd) (self tl f)))
+filter = (\f l : hfilter l f)
+hfoldl = y (\self f l x : matchList (\acc : acc) (\hd tl acc : self f tl (f acc hd)) l x)
+foldl  = (\f x l : hfoldl f l x)
+hfoldr = y (\self x f l : matchList x (\hd tl : f (self x f tl) hd) l)
+foldr  = (\f x l : hfoldr x f l)

src/Parser.hs

@@ -54,16 +54,9 @@ parseFunction = do
 
 parseAtomicBase :: Parser TricuAST
 parseAtomicBase = choice
-    [ try parseVarWithoutAssignment
-    , parseTreeLeaf
+    [ parseTreeLeaf
     , parseGrouped
     ]
-parseVarWithoutAssignment :: Parser TricuAST
-parseVarWithoutAssignment = do
-    LIdentifier name <- satisfy isIdentifier
-    if (name == "t" || name == "__result")
-    then fail $ "Reserved keyword: " ++ name ++ " cannot be assigned."
-    else notFollowedBy (satisfy (== LAssign)) *> return (SVar name)
 
 parseLambda :: Parser TricuAST
 parseLambda = between (satisfy (== LOpenParen)) (satisfy (== LCloseParen)) $ do

src/REPL.hs

@@ -66,4 +66,6 @@ decodeResult tc = case toNumber tc of
   Right num -> show num
   Left _ -> case toString tc of
     Right str -> "\"" ++ str ++ "\""
-    Left _ -> formatResult TreeCalculus tc
+    Left _ -> case toList tc of
+      Right list -> "[" ++ intercalate ", " (map decodeResult list) ++ "]"
+      Left _ -> formatResult TreeCalculus tc

test/Spec.hs

@@ -53,7 +53,7 @@ lexerTests = testGroup "Lexer Tests"
           expect = Right [LKeywordT, LStringLiteral "string", LIntegerLiteral 42]
       runParser tricuLexer "" input @?= expect
   , testCase "Lex invalid token" $ do
-      let input = "$invalid"
+      let input = "&invalid"
       case runParser tricuLexer "" input of
         Left _ -> return ()
         Right _ -> assertFailure "Expected lexer to fail on invalid token"