Don't require available library to run REPL or decoder

Basic implementation of a module system including tests.

.gitea/workflows/test-and-build.yml

@@ -54,16 +54,12 @@ jobs:
           cp -L ./result/bin/tricu ./tricu
           chmod 755 ./tricu
           nix develop --command upx ./tricu
-  
+
-      - name: Setup go for release action
-        uses: actions/setup-go@v5
-        with:
-          go-version: '>=1.20.1'
-  
       - name: Release binary
-        uses: https://gitea.com/actions/release-action@main
+        uses: akkuman/gitea-release-action@v1
         with:
           files: |-
             ./tricu
-          api_key: '${{ secrets.RELEASE_TOKEN }}'
+          token: '${{ secrets.RELEASE_TOKEN }}'
-          pre_release: true
+          body: '${{ gitea.event.head_commit.message }}'
+          prerelease: true

README.md

@@ -2,7 +2,7 @@
 
 ## Introduction
 
-tricu (pronounced "tree-shoe") is a purely functional interpreted language implemented in Haskell. It is fundamentally based on the application of [Tree Calculus](https://github.com/barry-jay-personal/typed_tree_calculus/blob/main/typed_program_analysis.pdf) terms, but minimal syntax sugar is included to provide a useful programming tool. 
+tricu (pronounced "tree-shoe") is a purely functional interpreted language implemented in Haskell. It is fundamentally based on the application of [Tree Calculus](https://github.com/barry-jay-personal/typed_tree_calculus/blob/main/typed_program_analysis.pdf) terms, but minimal syntax sugar is included to provide a useful programming tool. tricu is under active development and you can expect breaking changes with nearly every commit.
 
 tricu is the word for "tree" in Lojban: `(x1) is a tree of species/cultivar (x2)`.
 
@@ -10,12 +10,13 @@ tricu is the word for "tree" in Lojban: `(x1) is a tree of species/cultivar (x2)
 
 - Tree Calculus operator: `t`
 - Assignments: `x = t t`
+- Immutable definitions
 - Lambda abstraction syntax: `id = (\a : a)`
 - List, Number, and String literals: `[(2) ("Hello")]` 
 - Function application: `not (not false)`
 - Higher order/first-class functions: `map (\a : lconcat a "!") [("Hello")]`
 - Intensionality blurs the distinction between functions and data (see REPL examples)
-- Immutability
+- Simple module system for code organization
 
 ## REPL examples
 
@@ -44,7 +45,7 @@ tricu > 12
 
 [Releases are available for Linux.](https://git.eversole.co/James/tricu/releases)
 
-Or you can easily build and/or run this project using [Nix](https://nixos.org/download/).
+Or you can easily build and run this project using [Nix](https://nixos.org/download/).
 
 - Quick Start (REPL): 
   - `nix run git+https://git.eversole.co/James/tricu`
@@ -71,7 +72,7 @@ tricu eval [OPTIONS]
 
   -f --file=FILE  Input file path(s) for evaluation.
                     Defaults to stdin.
-  -t --form=FORM  Optional output form: (tree|fsl|ast|ternary|ascii).
+  -t --form=FORM  Optional output form: (tree|fsl|ast|ternary|ascii|decode).
                     Defaults to tricu-compatible `t` tree form.
 
 tricu decode [OPTIONS]

demos/equality.tri

@@ -1,19 +1,25 @@
+!module Equality
+
+!import "lib/base.tri" Lib
+
+main = lambdaEqualsTC
+
 -- We represent `false` with a Leaf and `true` with a Stem Leaf
-false = t
+demo_false = t
-true  = t t
+demo_true  = t t
 
 -- Tree Calculus representation of the Boolean `not` function
 not_TC?     = t (t (t t) (t t t)) (t t (t t t))
 
 -- /demos/toSource.tri contains an explanation of `triage`
-triage = (\a b c : t (t a b) c)
+demo_triage = \a b c : t (t a b) c
-matchBool = (\ot of : triage
+demo_matchBool = (\ot of : demo_triage
   of
   (\_ : ot)
   (\_ _ : ot)
 )
 -- Lambda representation of the Boolean `not` function
-not_Lambda? = matchBool false true
+not_Lambda? = demo_matchBool demo_false demo_true
 
 -- Since tricu eliminates Lambda terms to SKI combinators, the tree form of many
 -- functions defined via Lambda terms are larger than the most efficient TC
@@ -22,14 +28,14 @@ not_Lambda? = matchBool false true
 -- to different tree representations even if they share extensional behavior.
 
 -- Let's see if these are the same:
-lambdaEqualsTC = equal? not_TC? not_Lambda?
+lambdaEqualsTC = Lib.equal? not_TC? not_Lambda?
 
 -- Here are some checks to verify their extensional behavior is the same:
-true_TC?  = not_TC? false
+true_TC?  = not_TC? demo_false
-false_TC? = not_TC? true
+false_TC? = not_TC? demo_true
 
-true_Lambda?  = not_Lambda? false
+true_Lambda?  = not_Lambda? demo_false
-false_Lambda? = not_Lambda? true
+false_Lambda? = not_Lambda? demo_true
 
-bothTrueEqual?  = equal? true_TC?  true_Lambda?
+bothTrueEqual?  = Lib.equal? true_TC?  true_Lambda?
-bothFalseEqual? = equal? false_TC? false_Lambda?
+bothFalseEqual? = Lib.equal? false_TC? false_Lambda?

demos/levelOrderTraversal.tri

@@ -1,11 +1,14 @@
+!module LOT
+
+!import "lib/base.tri" Lib
+
+main = exampleTwo
 -- 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 nested lists where values act as labels. We
--- 
+-- require explicit notation of empty nodes. Empty nodes can be represented
--- We model labelled binary trees as sublists where values act as labels. We
+-- with an empty list, `[]`, which evaluates to a single node `t`.
--- 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]]]]
@@ -15,43 +18,42 @@
 --     2   3
 --    /   /  \
 --   4   5    6
---
 
-label = (\node : head node)
+label = \node : Lib.head node
 
-left  = (\node : if (emptyList node) 
+left = (\node : Lib.if (Lib.emptyList? node)
   [] 
-  (if (emptyList (tail node)) 
+  (Lib.if (Lib.emptyList? (Lib.tail node)) 
     [] 
-    (head (tail node))))
+    (Lib.head (Lib.tail node))))
 
-right = (\node : if (emptyList node) 
+right = (\node : Lib.if (Lib.emptyList? node) 
   [] 
-  (if (emptyList (tail node)) 
+  (Lib.if (Lib.emptyList? (Lib.tail node)) 
     [] 
-    (if (emptyList (tail (tail node))) 
+    (Lib.if (Lib.emptyList? (Lib.tail (Lib.tail node))) 
       [] 
-      (head (tail (tail node))))))
+      (Lib.head (Lib.tail (Lib.tail node))))))
 
-processLevel = y (\self queue : if (emptyList queue) 
+processLevel = Lib.y (\self queue : Lib.if (Lib.emptyList? queue) 
   [] 
-  (pair (map label queue) (self (filter 
+  (Lib.pair (Lib.map label queue) (self (Lib.filter 
-    (\node : not (emptyList node)) 
+    (\node : Lib.not? (Lib.emptyList? node)) 
-      (lconcat (map left queue) (map right queue))))))
+      (Lib.lconcat (Lib.map left queue) (Lib.map right queue))))))
 
-levelOrderTraversal_ = (\a : processLevel (t a t))
+levelOrderTraversal_ = \a : processLevel (t a t)
 
-toLineString = y (\self levels : if (emptyList levels) 
+toLineString = Lib.y (\self levels : Lib.if (Lib.emptyList? levels) 
   "" 
-  (lconcat 
+  (Lib.lconcat 
-    (lconcat (map (\x : lconcat x " ") (head levels)) "") 
+    (Lib.lconcat (Lib.map (\x : Lib.lconcat x " ") (Lib.head levels)) "") 
-    (if (emptyList (tail levels)) "" (lconcat (t (t 10 t) t) (self (tail levels))))))
+    (Lib.if (Lib.emptyList? (Lib.tail levels)) "" (Lib.lconcat (t (t 10 t) t) (self (Lib.tail levels))))))
 
-levelOrderToString = (\s : toLineString (levelOrderTraversal_ s))
+levelOrderToString = \s : toLineString (levelOrderTraversal_ s)
 
-flatten = foldl (\acc x : lconcat acc x) ""
+flatten = Lib.foldl (\acc x : Lib.lconcat acc x) ""
 
-levelOrderTraversal = (\s : lconcat (t 10 t) (flatten (levelOrderToString s)))
+levelOrderTraversal = \s : Lib.lconcat (t 10 t) (flatten (levelOrderToString s))
 
 exampleOne = levelOrderTraversal [("1") 
                                  [("2") [("4") t t] t] 
@@ -61,5 +63,3 @@ exampleTwo = levelOrderTraversal [("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]]]
-
-exampleTwo

demos/size.tri

@@ -1,19 +1,25 @@
-compose = (\f g x : f (g x))
+!module Size
 
-succ = y (\self : 
+!import "lib/base.tri" Lib
-  triage 
+
-    1 
+main = size size
-    t 
+
-    (triage 
+compose = \f g x : f (g x)
-      (t (t t)) 
+
-      (\_ tail : t t (self tail)) 
+succ = Lib.y (\self :
+  Lib.triage
+    1
+    t
+    (Lib.triage
+      (t (t t))
+      (\_ Lib.tail : t t (self Lib.tail))
       t))
 
-size = (\x : 
+size = (\x :
-  (y (\self x : 
+  (Lib.y (\self x :
-    compose succ 
+    compose succ
-      (triage 
+      (Lib.triage
-        (\x : x) 
+        (\x : x)
-        self 
+        self
-        (\x y : compose (self x) (self y)) 
+        (\x y : compose (self x) (self y))
         x)) x 0))

demos/toSource.tri

@@ -1,3 +1,8 @@
+!module ToSource
+
+!import "lib/base.tri" Lib
+
+main = toSource Lib.not?
 -- Thanks to intensionality, we can inspect the structure of a given value
 -- even if it's a function. This includes lambdas which are eliminated to
 -- Tree Calculus (TC) terms during evaluation.
@@ -8,39 +13,39 @@
 -- the Tree Calculus term, `triage` enables branching logic based on the term's 
 -- shape, making it possible to perform structure-specific operations such as
 -- reconstructing the terms' source code representation.
-triage = (\leaf stem fork : t (t leaf stem) fork)
+-- triage = (\leaf stem fork : t (t leaf stem) fork)
 
 -- Base case of a single Leaf
-sourceLeaf = t (head "t")
+sourceLeaf = t (Lib.head "t")
 
 -- Stem case
 sourceStem = (\convert : (\a rest :
-  t (head "(")                       -- Start with a left parenthesis "(".
+  t (Lib.head "(")                       -- Start with a left parenthesis "(".
-    (t (head "t")                    -- Add a "t"
+    (t (Lib.head "t")                    -- Add a "t"
-      (t (head " ")                  -- Add a space.
+      (t (Lib.head " ")                  -- Add a space.
-        (convert a                   -- Recursively convert the argument.
+        (convert a                       -- Recursively convert the argument.
-          (t (head ")") rest))))))   -- Close with ")" and append the rest.
+          (t (Lib.head ")") rest))))))   -- Close with ")" and append the rest.
 
 -- Fork case
 sourceFork = (\convert : (\a b rest :
-  t (head "(")                           -- Start with a left parenthesis "(".
+  t (Lib.head "(")                           -- Start with a left parenthesis "(".
-    (t (head "t")                        -- Add a "t"
+    (t (Lib.head "t")                        -- Add a "t"
-      (t (head " ")                      -- Add a space.
+      (t (Lib.head " ")                      -- Add a space.
-        (convert a                       -- Recursively convert the first arg.
+        (convert a                           -- Recursively convert the first arg.
-          (t (head " ")                  -- Add another space.
+          (t (Lib.head " ")                  -- Add another space.
-            (convert b                   -- Recursively convert the second arg.
+            (convert b                       -- Recursively convert the second arg.
-              (t (head ")") rest)))))))) -- Close with ")" and append the rest.
+              (t (Lib.head ")") rest)))))))) -- Close with ")" and append the rest.
 
 -- Wrapper around triage 
-toSource_ = y (\self arg :
+toSource_ = Lib.y (\self arg :
-  triage
+  Lib.triage
     sourceLeaf        -- `triage` "a" case, Leaf
     (sourceStem self) -- `triage` "b" case, Stem
     (sourceFork self) -- `triage` "c" case, Fork
     arg)              -- The term to be inspected
 
 -- toSource takes a single TC term and returns a String
-toSource = (\v : toSource_ v "")
+toSource = \v : toSource_ v ""
 
-exampleOne = toSource true -- OUT: "(t t)"
+exampleOne = toSource Lib.true -- OUT: "(t t)"
-exampleTwo = toSource not? -- OUT: "(t (t (t t) (t t t)) (t t (t t t)))"
+exampleTwo = toSource Lib.not? -- OUT: "(t (t (t t) (t t t)) (t t (t t t)))"

lib/base.tri

@@ -7,37 +7,26 @@ s     = t (t (k t)) t
 m     = s i i
 b     = s (k s) k
 c     = s (s (k s) (s (k k) s)) (k k)
-iC    = (\a b c : s a (k c) b)
+id    = \a : a
-iD    = b (b iC) iC
-iE    = b (b iD) iC
-yi    = (\i : b m (c b (i m)))
-y     = yi iC
-yC    = yi iD
-yD    = yi iE
-id    = (\a : a)
 pair  = t
-if    = (\cond then else : t (t else (t t then)) t cond)
+if    = \cond then else : t (t else (t t then)) t cond
 
-triage = (\leaf stem fork : t (t leaf stem) fork)
+y = ((\mut wait fun : wait mut (\x : fun (wait mut x)))
+     (\x : x x)
+     (\a0 a1 a2 : t (t a0) (t t a2) a1))
+
+triage = \leaf stem fork : t (t leaf stem) fork
 test   = triage "Leaf" (\_ : "Stem") (\_ _ : "Fork")
 
-matchBool = (\ot of : triage 
+matchBool = (\ot of : triage
-  of 
+  of
-  (\_ : ot) 
+  (\_ : ot)
   (\_ _ : ot)
 )
 
-matchList = (\oe oc : triage 
+matchList = \a b : triage a _ b
-  oe 
-  _ 
-  oc
-)
 
-matchPair = (\op : triage 
+matchPair = \a   : triage _ _ a
-  _ 
-  _ 
-  op
-)
 
 not? = matchBool false true
 and? = matchBool id (\_ : false)
@@ -46,51 +35,49 @@ emptyList? = matchList true (\_ _ : false)
 head = matchList t (\head _ : head)
 tail = matchList t (\_ tail : tail)
 
-lconcat = y (\self : matchList 
+lconcat = y (\self : matchList
-  (\k : k) 
+  (\k : k)
   (\h r k : pair h (self r k)))
 
-lAnd = (triage 
+lAnd = (triage
-  (\_     : false) 
+  (\_     : false)
-  (\_ x   : x) 
+  (\_ x   : x)
-  (\_ _ x : x)
+  (\_ _ x : x))
-)
 
-lOr = (triage 
+lOr = (triage
-  (\x     : x) 
+  (\x     : x)
-  (\_ _   : true) 
+  (\_ _   : true)
-  (\_ _ _ : true)
+  (\_ _ _ : true))
-)
 
-map_ = y (\self : 
+map_ = y (\self :
-  matchList 
+  matchList
-    (\_ : t) 
+    (\_ : t)
     (\head tail f : pair (f head) (self tail f)))
-map = (\f l : map_ l f)
+map = \f l : map_ l f
 
-equal? = y (\self : triage 
+equal? = y (\self : triage
-  (triage 
+  (triage
-    true 
+    true
-    (\_   : false) 
+    (\_   : false)
-    (\_ _ : false)) 
+    (\_ _ : false))
-  (\ax : 
+  (\ax :
-    triage 
+    triage
-      false 
+      false
-      (self ax) 
+      (self ax)
-      (\_ _ : false)) 
+      (\_ _ : false))
-  (\ax ay : 
+  (\ax ay :
-    triage 
+    triage
-      false 
+      false
-      (\_ : false) 
+      (\_ : false)
       (\bx by : lAnd (self ax bx) (self ay by))))
 
-filter_ = y (\self : matchList 
+filter_ = y (\self : matchList
-  (\_ : t) 
+  (\_ : t)
   (\head tail f : matchBool (t head) i (f head) (self tail f)))
-filter  = (\f l : filter_ l f)
+filter  = \f l : filter_ l f
 
 foldl_ = y (\self f l x : matchList (\acc : acc) (\head tail acc : self f tail (f acc head)) l x)
-foldl  = (\f x l : foldl_ f l x)
+foldl  = \f x l : foldl_ f l x
 
 foldr_ = y (\self x f l : matchList x (\head tail : f (self x f tail) head) l)
-foldr  = (\f x l : foldr_ x f l)
+foldr  = \f x l : foldr_ x f l

src/Eval.hs

@@ -3,38 +3,43 @@ module Eval where
 import Parser
 import Research
 
+import Data.List (partition, (\\))
 import Data.Map  (Map)
-
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 
 evalSingle :: Env -> TricuAST -> Env
 evalSingle env term
-  | SFunc name [] body <- term =
+  | SDef name [] body <- term
-      if
+  = case Map.lookup name env of
-        | Map.member name env -> 
+      Just existingValue
-            errorWithoutStackTrace $ 
+        | existingValue == evalAST env body -> env
-              "Error: Identifier '" ++ name ++ "' is already defined."
+        | otherwise -> errorWithoutStackTrace $
-        | otherwise -> 
+            "Unable to rebind immutable identifier: '" ++ name
-            let res = evalAST env body
+      Nothing ->
-            in Map.insert "__result" res (Map.insert name res env)
+        let res = evalAST env body
-  | SApp func arg <- term =
+        in Map.insert "!result" res (Map.insert name res env)
-      let res = apply (evalAST env func) (evalAST env arg)
+  | SApp func arg <- term 
-      in Map.insert "__result" res env
+  = let res = apply (evalAST env func) (evalAST env arg)
-  | SVar name <- term =
+      in Map.insert "!result" res env
-      case Map.lookup name env of
+  | SVar name <- term 
-        Just v  -> Map.insert "__result" v env
+  = case Map.lookup name env of
-        Nothing -> errorWithoutStackTrace $ "Variable " ++ name ++ " not defined"
+        Just v  -> Map.insert "!result" v env
-  | otherwise =
+        Nothing ->
-      Map.insert "__result" (evalAST env term) env
+          errorWithoutStackTrace $ "Variable `" ++ name ++ "` not defined\n\
+          \This error should never occur here. Please report this as an issue."
+  | otherwise 
+  = Map.insert "!result" (evalAST env term) env
 
 evalTricu :: Env -> [TricuAST] -> Env
-evalTricu env []     = env
+evalTricu env x = go env (reorderDefs env x)
-evalTricu env [x]    =
+  where
-  let updatedEnv = evalSingle env x
+    go env []     = env
-  in Map.insert "__result" (result updatedEnv) updatedEnv
+    go env [x]    =
-evalTricu env (x:xs) =
+      let updatedEnv = evalSingle env x
-  evalTricu (evalSingle env x) xs
+      in Map.insert "!result" (result updatedEnv) updatedEnv
+    go env (x:xs) =
+      evalTricu (evalSingle env x) xs
 
 evalAST :: Env -> TricuAST -> T
 evalAST env term
@@ -54,16 +59,29 @@ evalAST env term
         (errorWithoutStackTrace $ "Variable " ++ name ++ " not defined")
         name env
 
--- https://github.com/barry-jay-personal/typed_tree_calculus/blob/main/typed_program_analysis.pdf
--- Chapter 4: Lambda-Abstraction
 elimLambda :: TricuAST -> TricuAST
 elimLambda = go
   where
+    -- η-reduction
+    go (SLambda [v] (SApp f (SVar x)))
+      | v == x && not (isFree v f) = elimLambda f
+    -- Triage optimization
+    go (SLambda [a] (SLambda [b] (SLambda [c] body)))
+      | body == triageBody         = _TRIAGE
+      where
+        triageBody =
+          (SApp (SApp TLeaf (SApp (SApp TLeaf (SVar a)) (SVar b))) (SVar c))
+    -- Composition optimization
+    go (SLambda [f] (SLambda [g] (SLambda [x] body)))
+      | body == composeBody        = _COMPOSE
+      where
+        composeBody = SApp (SVar f) (SApp (SVar g) (SVar x))
+    -- General elimination
     go (SLambda (v:vs) body)
-      | null vs              = toSKI v (elimLambda body)
+      | null vs                    = toSKI v (elimLambda body)
-      | otherwise            = elimLambda (SLambda [v] (SLambda vs body))
+      | otherwise                  = elimLambda (SLambda [v] (SLambda vs body))
-    go (SApp f g)            = SApp (elimLambda f) (elimLambda g)
+    go (SApp f g)                  = SApp (elimLambda f) (elimLambda g)
-    go x                     = x
+    go x                           = x
 
     toSKI x (SVar y)
       | x == y           = _I
@@ -73,25 +91,101 @@ elimLambda = go
       | otherwise        = SApp (SApp _S (toSKI x n)) (toSKI x u)
     toSKI x t
       | not (isFree x t) = SApp _K t
-      | otherwise        = SApp (SApp _S (toSKI x t)) TLeaf
+      | otherwise        = errorWithoutStackTrace "Unhandled toSKI conversion"
 
-    _S = parseSingle "t (t (t t t)) t"
+    _S       = parseSingle "t (t (t t t)) t"
-    _K = parseSingle "t t"
+    _K       = parseSingle "t t"
-    _I = parseSingle "t (t (t t)) t"
+    _I       = parseSingle "t (t (t t)) t"
-    
+    _TRIAGE  = parseSingle "t (t (t t (t (t (t t t))))) t"
-    isFree x = Set.member x . freeVars
+    _COMPOSE = parseSingle "t (t (t t (t (t (t t t)) t))) (t t)"
-    freeVars (SVar    v    ) = Set.singleton v
+
-    freeVars (SInt    _    ) = Set.empty
+isFree :: String -> TricuAST -> Bool
-    freeVars (SStr    _    ) = Set.empty
+isFree x = Set.member x . freeVars
-    freeVars (SList   s    ) = foldMap freeVars s
+
-    freeVars (SApp    f a  ) = freeVars f <> freeVars a
+freeVars :: TricuAST -> Set.Set String
-    freeVars (TLeaf        ) = Set.empty
+freeVars (SVar    v    ) = Set.singleton v
-    freeVars (SFunc   _ _ b) = freeVars b
+freeVars (SInt    _    ) = Set.empty
-    freeVars (TStem   t    ) = freeVars t
+freeVars (SStr    _    ) = Set.empty
-    freeVars (TFork   l r  ) = freeVars l <> freeVars r
+freeVars (SList   s    ) = foldMap freeVars s
-    freeVars (SLambda v b  ) = foldr Set.delete (freeVars b) v
+freeVars (SApp    f a  ) = freeVars f <> freeVars a
+freeVars (TLeaf        ) = Set.empty
+freeVars (SDef   _ _ b)  = freeVars b
+freeVars (TStem   t    ) = freeVars t
+freeVars (TFork   l r  ) = freeVars l <> freeVars r
+freeVars (SLambda v b  ) = foldr Set.delete (freeVars b) v
+freeVars _               = Set.empty
+
+reorderDefs :: Env -> [TricuAST] -> [TricuAST]
+reorderDefs env defs
+  | not (null missingDeps) =
+      errorWithoutStackTrace $
+        "Missing dependencies detected: " ++ show missingDeps
+  | otherwise = orderedDefs ++ others
+  where
+    (defsOnly, others) = partition isDef defs
+    defNames = [ name | SDef name _ _ <- defsOnly ]
+
+    defsWithFreeVars = [(def, freeVars body) | def@(SDef _ _ body) <- defsOnly]
+
+    graph = buildDepGraph defsOnly
+    sortedDefs = sortDeps graph
+    defMap = Map.fromList [(name, def) | def@(SDef name _ _) <- defsOnly]
+    orderedDefs = map (\name -> defMap Map.! name) sortedDefs
+
+    freeVarsDefs = foldMap snd defsWithFreeVars
+    freeVarsOthers = foldMap freeVars others
+    allFreeVars = freeVarsDefs <> freeVarsOthers
+    validNames = Set.fromList defNames `Set.union` Set.fromList (Map.keys env)
+    missingDeps = Set.toList (allFreeVars `Set.difference` validNames)
+
+    isDef (SDef _ _ _) = True
+    isDef _            = False
+
+buildDepGraph :: [TricuAST] -> Map.Map String (Set.Set String)
+buildDepGraph topDefs
+  | not (null duplicateNames) =
+      errorWithoutStackTrace $
+        "Duplicate definitions detected: " ++ show duplicateNames
+  | otherwise =
+      Map.fromList
+        [ (name, depends topDefs (SDef name [] body))
+        | SDef name _ body <- topDefs]
+  where
+    names = [name | SDef name _ _ <- topDefs]
+    duplicateNames =
+      [ name | (name, count) <- Map.toList (countOccurrences names) , count > 1]
+    countOccurrences = foldr (\x -> Map.insertWith (+) x 1) Map.empty
+
+sortDeps :: Map.Map String (Set.Set String) -> [String]
+sortDeps graph = go [] Set.empty (Map.keys graph)
+  where
+    go sorted sortedSet [] = sorted
+    go sorted sortedSet remaining =
+      let ready = [ name | name <- remaining
+                        , let deps = Map.findWithDefault Set.empty name graph
+                        , Set.isSubsetOf deps sortedSet ]
+          notReady = remaining \\ ready
+      in if null ready
+         then errorWithoutStackTrace
+          "ERROR: Cyclic dependency detected and prohibited.\n\
+          \RESOLVE: Use nested lambdas."
+         else go (sorted ++ ready)
+                 (Set.union sortedSet (Set.fromList ready))
+                 notReady
+
+depends :: [TricuAST] -> TricuAST -> Set.Set String
+depends topDefs (SDef _ _ body) =
+  Set.intersection
+    (Set.fromList [n | SDef n _ _ <- topDefs])
+    (freeVars body)
+depends _ _ = Set.empty
 
 result :: Env -> T
-result r = case Map.lookup "__result" r of
+result r = case Map.lookup "!result" r of
   Just a -> a
-  Nothing -> errorWithoutStackTrace "No __result field found in provided environment"
+  Nothing -> errorWithoutStackTrace "No !result field found in provided env"
+
+mainResult :: Env -> T
+mainResult r = case Map.lookup "main" r of
+  Just  a -> a
+  Nothing -> errorWithoutStackTrace "No valid definition for `main` found."

src/FileEval.hs

@@ -1,30 +1,150 @@
 module FileEval where
 
 import Eval
+import Lexer
 import Parser
 import Research
 
+import Data.List       (partition)
+import Control.Monad   (foldM)
 import System.IO
 
 import qualified Data.Map as Map
+import qualified Data.Set as Set
 
 evaluateFileResult :: FilePath -> IO T
 evaluateFileResult filePath = do
   contents <- readFile filePath
-  let asts = parseTricu contents
+  let tokens = lexTricu contents
-  let finalEnv = evalTricu Map.empty asts
+  let moduleName = case parseProgram tokens of
-  case Map.lookup "__result" finalEnv of
+        Right ((SModule name) : _) -> name
-    Just finalResult -> return finalResult
+        _                          -> ""
-    Nothing -> errorWithoutStackTrace "No expressions to evaluate found"
+  case parseProgram tokens of
+    Left err -> errorWithoutStackTrace (handleParseError err)
+    Right _ -> do
+      ast <- preprocessFile filePath
+      let finalEnv = mainAlias moduleName $ evalTricu Map.empty ast
+      case Map.lookup "main" finalEnv of
+        Just finalResult -> return finalResult
+        Nothing -> errorWithoutStackTrace "No `main` function detected"
 
 evaluateFile :: FilePath -> IO Env
 evaluateFile filePath = do
   contents <- readFile filePath
-  let asts = parseTricu contents
+  let tokens = lexTricu contents
-  pure $ evalTricu Map.empty asts
+  let moduleName = case parseProgram tokens of
+        Right ((SModule name) : _) -> name
+        _                          -> ""
+  case parseProgram tokens of
+    Left err -> errorWithoutStackTrace (handleParseError err)
+    Right _ -> do
+      ast <- preprocessFile filePath
+      pure $ mainAlias moduleName $ evalTricu Map.empty ast
 
 evaluateFileWithContext :: Env -> FilePath -> IO Env
 evaluateFileWithContext env filePath = do
   contents <- readFile filePath
-  let asts = parseTricu contents
+  let tokens = lexTricu contents
-  pure $ evalTricu env asts
+  let moduleName = case parseProgram tokens of
+        Right ((SModule name) : _) -> name
+        _                          -> ""
+  case parseProgram tokens of
+    Left err -> errorWithoutStackTrace (handleParseError err)
+    Right _ -> do
+      ast <- preprocessFile filePath
+      pure $ mainAlias moduleName $ evalTricu env ast
+
+mainAlias :: String -> Env -> Env
+mainAlias "" env = env
+mainAlias moduleName env =
+  case Map.lookup (moduleName ++ ".main") env of
+    Just value -> Map.insert "main" value env
+    Nothing    -> env
+
+preprocessFile :: FilePath -> IO [TricuAST]
+preprocessFile filePath = preprocessFile' Set.empty filePath
+
+preprocessFile' :: Set.Set FilePath -> FilePath -> IO [TricuAST]
+preprocessFile' inProgress filePath
+  | filePath `Set.member` inProgress = 
+      errorWithoutStackTrace $ "Encountered cyclic import: " ++ filePath
+  | otherwise = do
+      contents <- readFile filePath
+      let tokens = lexTricu contents
+      case parseProgram tokens of
+        Left err -> errorWithoutStackTrace (handleParseError err)
+        Right asts -> do
+          let (moduleName, restAST) = extractModule asts
+          let (imports, nonImports) = partition isImport restAST
+          let newInProgress = Set.insert filePath inProgress
+          importedASTs <- concat <$> mapM (processImport newInProgress) imports
+          let namespacedAST = namespaceDefinitions moduleName nonImports
+          pure $ importedASTs ++ namespacedAST
+  where
+    extractModule :: [TricuAST] -> (String, [TricuAST])
+    extractModule ((SModule name) : xs) = (name, xs)
+    extractModule xs                    = ("", xs)
+
+    isImport :: TricuAST -> Bool
+    isImport (SImport _ _) = True
+    isImport _             = False
+
+    processImport :: Set.Set FilePath -> TricuAST -> IO [TricuAST]
+    processImport inProgress (SImport filePath moduleName) = do
+      importedAST <- preprocessFile' inProgress filePath
+      pure $ namespaceDefinitions moduleName importedAST
+    processImport _ _ = error "Unexpected non-import in processImport"
+
+namespaceDefinitions :: String -> [TricuAST] -> [TricuAST]
+namespaceDefinitions moduleName = map (namespaceDefinition moduleName)
+
+namespaceDefinition :: String -> TricuAST -> TricuAST
+namespaceDefinition "" def = def
+namespaceDefinition moduleName (SDef name args body)
+  | isPrefixed name = SDef name args (namespaceBody moduleName body)
+  | otherwise = SDef (namespaceVariable moduleName name) 
+                        args (namespaceBody moduleName body)
+namespaceDefinition moduleName other =
+  namespaceBody moduleName other
+
+namespaceBody :: String -> TricuAST -> TricuAST
+namespaceBody moduleName (SVar name)
+  | isPrefixed name = SVar name
+  | otherwise = SVar (namespaceVariable moduleName name)
+namespaceBody moduleName (SApp func arg) =
+  SApp (namespaceBody moduleName func) (namespaceBody moduleName arg)
+namespaceBody moduleName (SLambda args body) =
+  SLambda args (namespaceBodyScoped moduleName args body)
+namespaceBody moduleName (SList items) =
+  SList (map (namespaceBody moduleName) items)
+namespaceBody moduleName (TFork left right) =
+  TFork (namespaceBody moduleName left) (namespaceBody moduleName right)
+namespaceBody moduleName (TStem subtree) =
+  TStem (namespaceBody moduleName subtree)
+namespaceBody moduleName (SDef name args body)
+  | isPrefixed name = SDef name args (namespaceBody moduleName body)
+  | otherwise = SDef (namespaceVariable moduleName name) 
+                        args (namespaceBody moduleName body)
+namespaceBody _ other = other
+
+namespaceBodyScoped :: String -> [String] -> TricuAST -> TricuAST
+namespaceBodyScoped moduleName args body = case body of
+  SVar name ->
+    if name `elem` args
+      then SVar name
+      else namespaceBody moduleName (SVar name)
+  SApp func arg -> SApp (namespaceBodyScoped moduleName args func) (namespaceBodyScoped moduleName args arg)
+  SLambda innerArgs innerBody -> SLambda innerArgs (namespaceBodyScoped moduleName (args ++ innerArgs) innerBody)
+  SList items -> SList (map (namespaceBodyScoped moduleName args) items)
+  TFork left right -> TFork (namespaceBodyScoped moduleName args left) (namespaceBodyScoped moduleName args right)
+  TStem subtree -> TStem (namespaceBodyScoped moduleName args subtree)
+  SDef name innerArgs innerBody ->
+    SDef (namespaceVariable moduleName name) innerArgs (namespaceBodyScoped moduleName (args ++ innerArgs) innerBody)
+  other -> other
+
+isPrefixed :: String -> Bool
+isPrefixed name = '.' `elem` name
+
+namespaceVariable :: String -> String -> String
+namespaceVariable "" name = name
+namespaceVariable moduleName name = moduleName ++ "." ++ name

src/Lexer.hs

@@ -20,11 +20,11 @@ identifier = do
   first <- letterChar <|> char '_'
   rest  <- many $ letterChar 
               <|> digitChar 
-              <|> char '_' <|> char '-' <|> char '?' <|> char '!'
+              <|> char '_' <|> char '-' <|> char '?' <|> char '.'
               <|> char '$' <|> char '#' <|> char '@' <|> char '%'
   let name = first : rest
-  if (name == "t" || name == "__result")
+  if (name == "t" || name == "!result")
-    then fail "Keywords (`t`, `__result`) cannot be used as an identifier"
+    then fail "Keywords (`t`, `!result`) cannot be used as an identifier"
     else return (LIdentifier name)
 
 integerLiteral :: Lexer LToken
@@ -39,6 +39,22 @@ stringLiteral = do
   char '"' --"
   return (LStringLiteral content)
 
+lModule :: Lexer LToken
+lModule = do
+  _ <- string "!module"
+  space1
+  LIdentifier moduleName <- identifier
+  return (LModule moduleName)
+
+lImport :: Lexer LToken
+lImport = do
+  _ <- string "!import"
+  space1
+  LStringLiteral path <- stringLiteral
+  space1
+  LIdentifier name <- identifier
+  return (LImport path name)
+
 assign :: Lexer LToken
 assign = char '=' *> pure LAssign
 
@@ -72,28 +88,36 @@ sc = space
 tricuLexer :: Lexer [LToken]
 tricuLexer = do
   sc
+  header <- many $ do
+    tok <- choice
+      [ try lModule
+      , try lImport
+      , lnewline
+      ]
+    sc
+    pure tok
   tokens <- many $ do
     tok <- choice tricuLexer'
     sc
     pure tok
   sc
   eof
-  pure tokens
+  pure (header ++ tokens)
-    where
+  where
-      tricuLexer' = 
+    tricuLexer' =
-        [ try lnewline
+      [ try lnewline
-        , try identifier
+      , try identifier
-        , try keywordT
+      , try keywordT
-        , try integerLiteral
+      , try integerLiteral
-        , try stringLiteral
+      , try stringLiteral
-        , assign
+      , assign
-        , colon
+      , colon
-        , backslash
+      , backslash
-        , openParen
+      , openParen
-        , closeParen
+      , closeParen
-        , openBracket
+      , openBracket
-        , closeBracket
+      , closeBracket
-        ]
+      ]
 
 lexTricu :: String -> [LToken]
 lexTricu input = case runParser tricuLexer "" input of

src/Main.hs

@@ -1,6 +1,6 @@
 module Main where
 
-import Eval                   (evalTricu, result)
+import Eval                   (evalTricu, mainResult, result)
 import FileEval
 import Parser                 (parseTricu)
 import REPL
@@ -16,7 +16,7 @@ import qualified Data.Map as Map
 data TricuArgs
   = Repl
   | Evaluate { file :: [FilePath], form :: EvaluatedForm }
-  | Decode { file :: [FilePath] }
+  | TDecode { file :: [FilePath] }
   deriving (Show, Data, Typeable)
 
 replMode :: TricuArgs
@@ -31,7 +31,7 @@ evaluateMode = Evaluate
       \ Defaults to stdin."
       &= name "f" &= typ "FILE"
     , form = TreeCalculus &= typ "FORM"
-      &= help "Optional output form: (tree|fsl|ast|ternary|ascii).\n \
+      &= help "Optional output form: (tree|fsl|ast|ternary|ascii|decode).\n \
       \ Defaults to tricu-compatible `t` tree form."
       &= name "t"
   }
@@ -40,7 +40,7 @@ evaluateMode = Evaluate
   &= name "eval"
 
 decodeMode :: TricuArgs
-decodeMode = Decode
+decodeMode = TDecode
   { file = def
     &= help "Optional input file path to attempt decoding.\n \
     \ Defaults to stdin."
@@ -60,8 +60,7 @@ main = do
     Repl -> do
       putStrLn "Welcome to the tricu REPL"
       putStrLn "You can exit with `CTRL+D` or the `:_exit` command.`"
-      library <- liftIO $ evaluateFile "./lib/base.tri"
+      repl Map.empty
-      repl $ Map.delete "__result" library
     Evaluate { file = filePaths, form = form } -> do
       result <- case filePaths of
         [] -> do
@@ -70,15 +69,14 @@ main = do
         (filePath:restFilePaths) -> do
             initialEnv <- evaluateFile filePath
             finalEnv <- foldM evaluateFileWithContext initialEnv restFilePaths
-            pure $ result finalEnv
+            pure $ mainResult finalEnv
       let fRes = formatResult form result
       putStr fRes
-    Decode { file = filePaths } -> do
+    TDecode { file = filePaths } -> do
       value <- case filePaths of
         [] -> getContents
         (filePath:_) -> readFile filePath
-      library <- liftIO $ evaluateFile "./lib/base.tri"
+      putStrLn $ decodeResult $ result $ evalTricu Map.empty $ parseTricu value
-      putStrLn $ decodeResult $ result $ evalTricu library $ parseTricu value
 
 runTricu :: String -> T
 runTricu input =

src/Parser.hs

@@ -74,9 +74,33 @@ parseSingle input =
 parseProgramM :: ParserM [TricuAST]
 parseProgramM = do
   skipMany topLevelNewline
+  moduleNode <- optional parseModuleM
+  skipMany topLevelNewline
+  importNodes <- many (do
+    node <- parseImportM
+    skipMany topLevelNewline
+    return node)
+  skipMany topLevelNewline
   exprs <- sepEndBy parseOneExpression (some topLevelNewline)
   skipMany topLevelNewline
-  return exprs
+  return (maybe [] (: []) moduleNode ++ importNodes ++ exprs)
+
+
+parseModuleM :: ParserM TricuAST
+parseModuleM = do
+  LModule moduleName <- satisfyM isModule
+  pure (SModule moduleName)
+  where
+    isModule (LModule _) = True
+    isModule _           = False
+
+parseImportM :: ParserM TricuAST
+parseImportM = do
+  LImport filePath moduleName <- satisfyM isImport
+  pure (SImport filePath moduleName)
+  where
+    isImport (LImport _ _) = True
+    isImport _             = False
 
 parseOneExpression :: ParserM TricuAST
 parseOneExpression = scnParserM *> parseExpressionM
@@ -85,13 +109,10 @@ scnParserM :: ParserM ()
 scnParserM = skipMany $ do
   t  <- lookAhead anySingle
   st <- get
-  if | (parenDepth st > 0 || bracketDepth st > 0) && case t of
+  if | (parenDepth st > 0 || bracketDepth st > 0) && (t == LNewline) ->
-         LNewline -> True
+       void $ satisfyM (== LNewline)
-         _        -> False -> void $ satisfyM $ \case
+     | otherwise ->
-           LNewline -> True
+       fail "In nested context or no space token" <|> empty
-           _        -> False
-     | otherwise -> fail "In nested context or no space token" <|> empty
-
 
 eofM :: ParserM ()
 eofM = lift eof
@@ -109,32 +130,23 @@ parseExpressionM = choice
 
 parseFunctionM :: ParserM TricuAST
 parseFunctionM = do
-  LIdentifier name <- satisfyM $ \case
+  let ident = (\case LIdentifier _ -> True; _ -> False)
-    LIdentifier _ -> True
+  LIdentifier name <- satisfyM ident
-    _             -> False
+  args <- many $ satisfyM ident
-  args <- many $ satisfyM $ \case
-    LIdentifier _ -> True
-    _             -> False
   _    <- satisfyM (== LAssign)
   scnParserM
   body <- parseExpressionM
-  pure (SFunc name (map getIdentifier args) body)
+  pure (SDef name (map getIdentifier args) body)
 
 parseLambdaM :: ParserM TricuAST
-parseLambdaM =
+parseLambdaM = do
-  between (satisfyM (== LOpenParen)) (satisfyM (== LCloseParen)) $ do
+  let ident = (\case LIdentifier _ -> True; _ -> False)
-    _     <- satisfyM (== LBackslash)
+  _      <- satisfyM (== LBackslash)
-    param <- satisfyM $ \case
+  params <- some (satisfyM ident)
-      LIdentifier _ -> True
+  _      <- satisfyM (== LColon)
-      _             -> False
+  scnParserM
-    rest  <- many $ satisfyM $ \case
+  body  <- parseLambdaExpressionM
-      LIdentifier _ -> True
+  pure $ foldr (\param acc -> SLambda [getIdentifier param] acc) body params
-      _             -> False
-    _     <- satisfyM (== LColon)
-    scnParserM
-    body <- parseLambdaExpressionM
-    let nested = foldr (\v acc -> SLambda [getIdentifier v] acc) body rest
-    pure (SLambda [getIdentifier param] nested)
 
 parseLambdaExpressionM :: ParserM TricuAST
 parseLambdaExpressionM = choice
@@ -180,9 +192,8 @@ parseAtomicBaseM = choice
 
 parseTreeLeafM :: ParserM TricuAST
 parseTreeLeafM = do
-  _ <- satisfyM $ \case
+  let keyword = (\case LKeywordT -> True; _ -> False)
-    LKeywordT -> True
+  _ <- satisfyM keyword
-    _         -> False
   notFollowedBy $ lift $ satisfy (== LAssign)
   pure TLeaf
 
@@ -248,37 +259,38 @@ parseGroupedItemM = do
 
 parseSingleItemM :: ParserM TricuAST
 parseSingleItemM = do
-  token <- satisfyM $ \case
+  token <- satisfyM (\case LIdentifier _ -> True; LKeywordT -> True; _ -> False)
-    LIdentifier _ -> True
+  if | LIdentifier name <- token -> pure (SVar name)
-    LKeywordT     -> True
+     | token == LKeywordT        -> pure TLeaf
-    _             -> False
+     | otherwise                 -> fail "Unexpected token in list item"
-  case token of
-    LIdentifier name -> pure (SVar name)
-    LKeywordT        -> pure TLeaf
-    _                -> fail "Unexpected token in list item"
 
 parseVarM :: ParserM TricuAST
 parseVarM = do
-  LIdentifier name <- satisfyM $ \case
+  satisfyM (\case LIdentifier _ -> True; _ -> False) >>= \case
-    LIdentifier _ -> True
+    LIdentifier name
-    _             -> False
+      | name == "t" || name == "!result" ->
-  if name == "t" || name == "__result"
+        fail ("Reserved keyword: " ++ name ++ " cannot be assigned.")
-    then fail ("Reserved keyword: " ++ name ++ " cannot be assigned.")
+      | otherwise                         ->
-    else pure (SVar name)
+         pure (SVar name)
+    _ -> fail "Unexpected token while parsing variable"
 
 parseIntLiteralM :: ParserM TricuAST
 parseIntLiteralM = do
-  LIntegerLiteral value <- satisfyM $ \case
+  let intL = (\case LIntegerLiteral _ -> True; _ -> False)
-    LIntegerLiteral _ -> True
+  token <- satisfyM intL
-    _                 -> False
+  if | LIntegerLiteral value <- token ->
-  pure (SInt value)
+       pure (SInt value)
+     | otherwise                      ->
+       fail "Unexpected token while parsing integer literal"
 
 parseStrLiteralM :: ParserM TricuAST
 parseStrLiteralM = do
-  LStringLiteral value <- satisfyM $ \case 
+  let strL = (\case LStringLiteral _ -> True; _ -> False)
-    LStringLiteral _ -> True
+  token <- satisfyM strL
-    _ -> False
+  if | LStringLiteral value <- token ->
-  pure (SStr value)
+       pure (SStr value)
+     | otherwise                     ->
+       fail "Unexpected token while parsing string literal"
 
 getIdentifier :: LToken -> String
 getIdentifier (LIdentifier name) = name

src/REPL.hs

@@ -26,7 +26,7 @@ repl env = runInputT defaultSettings (loop env)
         | Just s  <- minput, strip s == ""      -> do
           outputStrLn ""
           loop env
-        | Just s  <- minput, strip s == "!load" -> do
+        | Just s  <- minput, strip s == "!import" -> do
           path <- getInputLine "File path to load < "
           if
             | Nothing <- path -> do
@@ -34,7 +34,7 @@ repl env = runInputT defaultSettings (loop env)
               loop env
             | Just p  <- path -> do
               loadedEnv <- liftIO $ evaluateFileWithContext env (strip p) `catch` \e -> errorHandler env e
-              loop $ Map.delete "__result" (Map.union loadedEnv env)
+              loop $ Map.delete "!result" (Map.union loadedEnv env)
         | Just s <- minput -> do
           if
             | take 2 s == "--" -> loop env
@@ -47,7 +47,7 @@ repl env = runInputT defaultSettings (loop env)
       let asts   = parseTricu input
           newEnv = evalTricu env asts
       if
-        | Just r <- Map.lookup "__result" newEnv -> do
+        | Just r <- Map.lookup "!result" newEnv -> do
           putStrLn $ "tricu > " ++ decodeResult r
         | otherwise -> return ()
       return newEnv
@@ -59,10 +59,3 @@ repl env = runInputT defaultSettings (loop env)
     
     strip :: String -> String
     strip = dropWhileEnd isSpace . dropWhile isSpace
-
-decodeResult :: T -> String
-decodeResult tc
-  | Right num  <- toNumber tc = show num
-  | Right str  <- toString tc = "\"" ++ str ++ "\""
-  | Right list <- toList tc   = "[" ++ intercalate ", " (map decodeResult list) ++ "]"
-  | otherwise                 = formatResult TreeCalculus tc

src/Research.hs

@@ -19,13 +19,15 @@ data TricuAST
   | SInt Int
   | SStr String
   | SList [TricuAST]
-  | SFunc String [String] TricuAST
+  | SDef String [String] TricuAST
   | SApp TricuAST TricuAST
   | TLeaf
   | TStem TricuAST
   | TFork TricuAST TricuAST
   | SLambda [String] TricuAST
   | SEmpty
+  | SModule String
+  | SImport String String
   deriving (Show, Eq, Ord)
 
 -- Lexer Tokens
@@ -42,10 +44,12 @@ data LToken
   | LOpenBracket
   | LCloseBracket
   | LNewline
+  | LModule String
+  | LImport String String
   deriving (Show, Eq, Ord)
 
 -- Output formats
-data EvaluatedForm = TreeCalculus | FSL | AST | Ternary | Ascii
+data EvaluatedForm = TreeCalculus | FSL | AST | Ternary | Ascii | Decode
   deriving (Show, Data, Typeable)
 
 -- Environment containing previously evaluated TC terms
@@ -115,6 +119,7 @@ formatResult FSL          = show
 formatResult AST          = show . toAST
 formatResult Ternary      = toTernaryString
 formatResult Ascii        = toAscii
+formatResult Decode       = decodeResult
 
 toSimpleT :: String -> String
 toSimpleT s = T.unpack 
@@ -147,4 +152,9 @@ toAscii tree = go tree "" True
         ++ go left (prefix ++ (if isLast then "    " else "|   ")) False
         ++ go right (prefix ++ (if isLast then "    " else "|   ")) True
 
--- Utility
+decodeResult :: T -> String
+decodeResult tc
+  | Right num  <- toNumber tc = show num
+  | Right str  <- toString tc = "\"" ++ str ++ "\""
+  | Right list <- toList tc   = "[" ++ intercalate ", " (map decodeResult list) ++ "]"
+  | otherwise                 = formatResult TreeCalculus tc

test/Spec.hs

@@ -7,12 +7,13 @@ import Parser
 import REPL
 import Research
 
-import Control.Exception (evaluate, try, SomeException)
+import Control.Exception      (evaluate, try, SomeException)
 import Control.Monad.IO.Class (liftIO)
+import Data.List              (isInfixOf)
 import Test.Tasty
 import Test.Tasty.HUnit
 import Test.Tasty.QuickCheck
-import Text.Megaparsec (runParser)
+import Text.Megaparsec        (runParser)
 
 import qualified Data.Map as Map
 import qualified Data.Set as Set
@@ -25,16 +26,18 @@ runTricu s = show $ result (evalTricu Map.empty $ parseTricu s)
 
 tests :: TestTree
 tests = testGroup "Tricu Tests"
-  [ lexerTests
+  [ lexer
-  , parserTests
+  , parser
-  , evaluationTests
+  , simpleEvaluation
-  , lambdaEvalTests
+  , lambdas
-  , libraryTests
+  , baseLibrary
-  , fileEvaluationTests
+  , fileEval
+  , modules
+  , demos
   ]
 
-lexerTests :: TestTree
+lexer :: TestTree
-lexerTests = testGroup "Lexer Tests"
+lexer = testGroup "Lexer Tests"
   [ testCase "Lex simple identifiers" $ do
       let input = "x a b = a"
           expect = Right [LIdentifier "x", LIdentifier "a", LIdentifier "b", LAssign, LIdentifier "a"]
@@ -69,13 +72,13 @@ lexerTests = testGroup "Lexer Tests"
         Right i -> i @?= expect
 
   , testCase "Error when using invalid characters in identifiers" $ do
-        case (runParser tricuLexer "" "__result = 5") of
+        case (runParser tricuLexer "" "!result = 5") of
           Left _ -> return ()
-          Right _ -> assertFailure "Expected failure when trying to assign the value of __result"
+          Right _ -> assertFailure "Expected failure when trying to assign the value of !result"
   ]
 
-parserTests :: TestTree
+parser :: TestTree
-parserTests = testGroup "Parser Tests"
+parser = testGroup "Parser Tests"
   [ testCase "Error when assigning a value to T" $ do
       let tokens = lexTricu "t = x" 
       case parseSingleExpr tokens of
@@ -84,7 +87,7 @@ parserTests = testGroup "Parser Tests"
 
   , testCase "Parse function definitions" $ do
       let input = "x = (\\a b c : a)"
-          expect = SFunc "x" [] (SLambda ["a"] (SLambda ["b"] (SLambda ["c"] (SVar "a"))))
+          expect = SDef "x" [] (SLambda ["a"] (SLambda ["b"] (SLambda ["c"] (SVar "a"))))
       parseSingle input @?= expect
 
   , testCase "Parse nested Tree Calculus terms" $ do
@@ -104,7 +107,7 @@ parserTests = testGroup "Parser Tests"
 
   , testCase "Parse function with applications" $ do
       let input  = "f = (\\x : t x)"
-          expect = SFunc "f" [] (SLambda ["x"] (SApp TLeaf (SVar "x")))
+          expect = SDef "f" [] (SLambda ["x"] (SApp TLeaf (SVar "x")))
       parseSingle input @?= expect
 
   , testCase "Parse nested lists" $ do
@@ -146,7 +149,7 @@ parserTests = testGroup "Parser Tests"
 
   , testCase "Parse nested parentheses in function body" $ do
       let input  = "f = (\\x : t (t (t t)))"
-          expect = SFunc "f" [] (SLambda ["x"] (SApp TLeaf (SApp TLeaf (SApp TLeaf TLeaf))))
+          expect = SDef "f" [] (SLambda ["x"] (SApp TLeaf (SApp TLeaf (SApp TLeaf TLeaf))))
       parseSingle input @?= expect
 
   , testCase "Parse lambda abstractions" $ do
@@ -156,12 +159,12 @@ parserTests = testGroup "Parser Tests"
 
   , testCase "Parse multiple arguments to lambda abstractions" $ do
       let input  = "x = (\\a b : a)"
-          expect = SFunc "x" [] (SLambda ["a"] (SLambda ["b"] (SVar "a")))
+          expect = SDef "x" [] (SLambda ["a"] (SLambda ["b"] (SVar "a")))
       parseSingle input @?= expect
 
   , testCase "Grouping T terms with parentheses in function application" $ do
       let input  = "x = (\\a : a)\nx (t)"
-          expect = [SFunc "x" [] (SLambda ["a"] (SVar "a")),SApp (SVar "x") TLeaf]
+          expect = [SDef "x" [] (SLambda ["a"] (SVar "a")),SApp (SVar "x") TLeaf]
       parseTricu input @?= expect
 
   , testCase "Comments 1" $ do
@@ -175,8 +178,8 @@ parserTests = testGroup "Parser Tests"
       parseTricu input @?= expect
   ]
 
-evaluationTests :: TestTree
+simpleEvaluation :: TestTree
-evaluationTests = testGroup "Evaluation Tests"
+simpleEvaluation = testGroup "Evaluation Tests"
   [ testCase "Evaluate single Leaf" $ do
       let input = "t"
       let ast = parseSingle input
@@ -244,7 +247,7 @@ evaluationTests = testGroup "Evaluation Tests"
       (result env) @?= (Stem (Stem Leaf))
 
 
-  , testCase "Evaluate variable shadowing" $ do
+  , testCase "Immutable definitions" $ do
       let input = "x = t t\nx = t\nx"
           env = evalTricu Map.empty (parseTricu input)
       result <- try (evaluate (runTricu input)) :: IO (Either SomeException String)
@@ -260,8 +263,8 @@ evaluationTests = testGroup "Evaluation Tests"
       result env @?= Fork (Fork (Stem Leaf) (Fork Leaf Leaf)) Leaf
   ]
 
-lambdaEvalTests :: TestTree
+lambdas :: TestTree
-lambdaEvalTests = testGroup "Lambda Evaluation Tests"
+lambdas = testGroup "Lambda Evaluation Tests"
   [ testCase "Lambda Identity Function" $ do
       let input = "id = (\\x : x)\nid t"
       runTricu input @?= "Leaf"
@@ -340,8 +343,8 @@ lambdaEvalTests = testGroup "Lambda Evaluation Tests"
         runTricu input @?= "Fork Leaf (Fork (Stem Leaf) Leaf)"
   ]
 
-libraryTests :: TestTree
+baseLibrary :: TestTree
-libraryTests = testGroup "Library Tests"
+baseLibrary = testGroup "Library Tests"
   [ testCase "K combinator 1" $ do
       library <- evaluateFile "./lib/base.tri"
       let input = "k (t) (t t)"
@@ -476,8 +479,8 @@ libraryTests = testGroup "Library Tests"
       result env @?= Stem Leaf
   ]
 
-fileEvaluationTests :: TestTree
+fileEval :: TestTree
-fileEvaluationTests = testGroup "Evaluation tests"
+fileEval = testGroup "File evaluation tests"
   [ testCase "Forks" $ do
       res <- liftIO $ evaluateFileResult "./test/fork.tri"
       res @?= Fork Leaf Leaf
@@ -487,11 +490,64 @@ fileEvaluationTests = testGroup "Evaluation tests"
       res @?= Fork (Stem Leaf) Leaf
 
   , testCase "Mapping and Equality" $ do
-      res <- liftIO $ evaluateFileResult "./test/map.tri"
+      library <- liftIO $ evaluateFile "./lib/base.tri"
-      res @?= Stem Leaf
+      fEnv    <- liftIO $ evaluateFileWithContext library "./test/map.tri"
+      (mainResult fEnv) @?= Stem Leaf
 
   , testCase "Eval and decoding string" $ do
       library <- liftIO $ evaluateFile "./lib/base.tri"
       res <- liftIO $ evaluateFileWithContext library "./test/string.tri"
       decodeResult (result res) @?= "\"String test!\""
   ]
+
+modules :: TestTree
+modules = testGroup "Test modules"
+  [ testCase "Detect cyclic dependencies" $ do
+      result <- try (liftIO $ evaluateFileResult "./test/cycle-1.tri") :: IO (Either SomeException T)
+      case result of
+        Left e -> do
+          let errorMsg = show e
+          if "Encountered cyclic import" `isInfixOf` errorMsg
+            then return ()
+            else assertFailure $ "Unexpected error: " ++ errorMsg
+        Right _ -> assertFailure "Expected cyclic dependencies"
+  , testCase "Module imports and namespacing" $ do
+      res <- liftIO $ evaluateFileResult "./test/namespace-A.tri"
+      res @?= Leaf
+  , testCase "Multiple imports" $ do
+      res <- liftIO $ evaluateFileResult "./test/vars-A.tri"
+      res @?= Leaf
+  , testCase "Error on unresolved variable" $ do
+      result <- try (liftIO $ evaluateFileResult "./test/unresolved-A.tri") :: IO (Either SomeException T)
+      case result of
+        Left e -> do
+          let errorMsg = show e
+          if "undefinedVar" `isInfixOf` errorMsg
+            then return ()
+            else assertFailure $ "Unexpected error: " ++ errorMsg
+        Right _ -> assertFailure "Expected unresolved variable error"
+  , testCase "Multi-level imports" $ do
+      res <- liftIO $ evaluateFileResult "./test/multi-level-A.tri"
+      res @?= Leaf
+  , testCase "Lambda expression namespaces" $ do
+      res <- liftIO $ evaluateFileResult "./test/lambda-A.tri"
+      res @?= Leaf
+  ]
+
+
+-- All of our demo tests are also module tests
+demos :: TestTree
+demos = testGroup "Test provided demo functionality"
+  [ testCase "Structural equality demo" $ do
+      res     <- liftIO $ evaluateFileResult "./demos/equality.tri"
+      decodeResult res @?= "t t"
+  , testCase "Convert values back to source code demo" $ do
+      res     <- liftIO $ evaluateFileResult "./demos/toSource.tri"
+      decodeResult res @?= "\"(t (t (t t) (t t t)) (t t (t t t)))\""
+  , testCase "Determining the size of functions" $ do
+      res     <- liftIO $ evaluateFileResult "./demos/size.tri"
+      decodeResult res @?= "454"
+  , testCase "Level Order Traversal demo" $ do
+      res     <- liftIO $ evaluateFileResult "./demos/levelOrderTraversal.tri"
+      decodeResult res @?= "\"\n1 \n2 3 \n4 5 6 7 \n8 11 10 9 12 \""
+  ]

test/comments-1.tri

@@ -2,7 +2,7 @@
 -- t (t t) (t (t t t))
 -- t (t t t) (t t)
 -- x = (\a : a)
-t (t t) t -- Fork (Stem Leaf) Leaf
+main = t (t t) t -- Fork (Stem Leaf) Leaf
 -- t t
 -- x
 -- x = (\a : a)

test/cycle-1.tri

@@ -0,0 +1,5 @@
+!module Cycle
+
+!import "test/cycle-2.tri" Cycle2
+
+cycle1 = t Cycle2.cycle2

test/cycle-2.tri

@@ -0,0 +1,5 @@
+!module Cycle2
+
+!import "test/cycle-1.tri" Cycle1
+
+cycle2 = t Cycle1.cycle1

test/fork.tri

@@ -1 +1 @@
-t t t 
+main = t t t 

test/lambda-A.tri

@@ -0,0 +1,2 @@
+!module A
+main = (\x : x) t

test/map.tri

@@ -1,24 +1,2 @@
-false = t
-true = t t
-_ = t
-k = t t
-i = t (t k) t
-s = t (t (k t)) t
-m = s i i
-b = s (k s) k
-c = s (s (k s) (s (k k) s)) (k k)
-iC = (\a b c : s a (k c) b)
-yi = (\i : b m (c b (i m)))
-y = yi iC
-triage = (\a b c : t (t a b) c)
-pair = t
-matchList = (\oe oc : triage oe _ oc)
-lconcat = y (\self : matchList (\k : k) (\h r k : pair h (self r k)))
-hmap = y (\self : matchList (\f : t) (\hd tl f : pair (f hd) (self tl f)))
-map = (\f l : hmap l f)
-lAnd = triage (\x : false) (\_ x : x) (\_ _ x : x)
-lOr = triage (\x : x) (\_ _ : true) (\_ _ x : true)
-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))))
-
 x = map (\i : lconcat "Successfully concatenated " i) [("two strings!")]
-equal x [("Successfully concatenated two strings!")]
+main = equal? x [("Successfully concatenated two strings!")]

test/modules-1.tri

@@ -0,0 +1,5 @@
+!module Test
+
+!import "lib/base.tri" Lib
+
+main = Lib.not? t

test/modules-2.tri

@@ -0,0 +1 @@
+n = t t t

test/multi-level-A.tri

@@ -0,0 +1,3 @@
+!module A
+!import "./test/multi-level-B.tri" B
+main = B.main

test/multi-level-B.tri

@@ -0,0 +1,3 @@
+!module B
+!import "./test/multi-level-C.tri" C
+main = C.val

test/multi-level-C.tri

@@ -0,0 +1,2 @@
+!module C
+val = t

test/namespace-A.tri

@@ -0,0 +1,3 @@
+!module A
+!import "./test/namespace-B.tri" B
+main = B.x

test/namespace-B.tri

@@ -0,0 +1,2 @@
+!module B
+x = t

test/size.tri

@@ -0,0 +1,21 @@
+compose = \f g x : f (g x)
+
+succ = y (\self :
+  triage
+    1
+    t
+    (triage
+      (t (t t))
+      (\_ tail : t t (self tail))
+      t))
+
+size = (\x :
+  (y (\self x :
+    compose succ
+      (triage
+        (\x : x)
+        self
+        (\x y : compose (self x) (self y))
+        x)) x 0))
+
+size size

test/undefined.tri

@@ -0,0 +1 @@
+namedTerm = undefinedForTesting

test/unresolved-A.tri

@@ -0,0 +1,2 @@
+!module A
+main = undefinedVar

test/vars-A.tri

@@ -0,0 +1,7 @@
+!module A
+
+!import "./test/vars-B.tri" B
+
+!import "./test/vars-C.tri" C
+
+main = B.y (C.z)

test/vars-B.tri

@@ -0,0 +1,2 @@
+!module B
+y = \x : x

test/vars-C.tri

@@ -0,0 +1,2 @@
+!module C
+z = t

tricu.cabal

@@ -1,7 +1,7 @@
 cabal-version: 1.12
 
 name:           tricu
-version:        0.7.0
+version:        0.12.0
 description:    A micro-language for exploring Tree Calculus
 author:         James Eversole
 maintainer:     james@eversole.co