From 740347ad7c939db05df80942a09bc17f2a8cba6d Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Fri, 22 Jul 2022 14:16:47 +0200
Subject: [PATCH 01/85] JuvixCore started

---
 src/Juvix/Core/Builtins.hs  |   2 +
 src/Juvix/Core/Context.hs   |   2 +
 src/Juvix/Core/Evaluator.hs |   2 +
 src/Juvix/Core/GNode.hs     | 161 ++++++++++++++++++++++++++++++++++++
 4 files changed, 167 insertions(+)
 create mode 100644 src/Juvix/Core/Builtins.hs
 create mode 100644 src/Juvix/Core/Context.hs
 create mode 100644 src/Juvix/Core/Evaluator.hs
 create mode 100644 src/Juvix/Core/GNode.hs

diff --git a/src/Juvix/Core/Builtins.hs b/src/Juvix/Core/Builtins.hs
new file mode 100644
index 0000000000..ef593238fc
--- /dev/null
+++ b/src/Juvix/Core/Builtins.hs
@@ -0,0 +1,2 @@
+module Juvix.Core.Builtins where
+
diff --git a/src/Juvix/Core/Context.hs b/src/Juvix/Core/Context.hs
new file mode 100644
index 0000000000..5ced00226e
--- /dev/null
+++ b/src/Juvix/Core/Context.hs
@@ -0,0 +1,2 @@
+module Juvix.Core.Context where
+
diff --git a/src/Juvix/Core/Evaluator.hs b/src/Juvix/Core/Evaluator.hs
new file mode 100644
index 0000000000..8eaba14387
--- /dev/null
+++ b/src/Juvix/Core/Evaluator.hs
@@ -0,0 +1,2 @@
+module Juvix.Core.Evaluator where
+
diff --git a/src/Juvix/Core/GNode.hs b/src/Juvix/Core/GNode.hs
new file mode 100644
index 0000000000..493082d40c
--- /dev/null
+++ b/src/Juvix/Core/GNode.hs
@@ -0,0 +1,161 @@
+module Juvix.Core.GNode where
+
+{-
+  This file defines the graph representation of JuvixCore (GNode datatype) and
+  general recursors on it.
+-}
+
+import Juvix.Prelude
+
+{---------------------------------------------------------------------------------}
+{- Program graph datatype -}
+
+-- Consecutive symbol IDs for builtins and reachable user functions.
+type Symbol = Word
+
+-- Tag of a constructor, uniquely identifying it. Tag values are consecutive and
+-- separate from symbol IDs. We might need fixed special tag values in Core for
+-- common "builtin" constructors, e.g., lists, pairs, so that the code generator
+-- can treat them specially.
+type Tag = Word
+
+-- de Bruijn index
+type Index = Word
+
+-- `GNode i` is the type of nodes in the program graph, where `i` is the info
+-- type. `GNode` itself contains only runtime-relevant information.
+-- Runtime-irrelevant annotations (including all type information) are stored in
+-- the `i` argument of the `NodeInfo` nodes.
+data GNode i
+  = -- De Bruijn index of a locally lambda-bound variable.
+    Var !i !Index
+  | -- Global identifier of a function (with corresponding `GNode` in the global
+    -- context).
+    Ident !i !Symbol
+  | -- Global identifier of an external / builtin (no corresponding GNode). For
+    -- example, basic arithmetic operations go into `Builtin`. The numeric
+    -- symbol values for basic builtin operations (e.g. arithmetic) should be
+    -- fixed in Core, so that the evaluator and the code generator know about
+    -- them and can treat them specially.
+    Builtin !i !Symbol
+  | Literal !i {-# UNPACK #-} !Constant
+  | App !i !(GNode i) ![GNode i]
+  | Lambda !i !(GNode i)
+  | -- `let x := value in body` is not reducible to lambda + application for the purposes
+    -- of ML-polymorphic / dependent type checking or code generation!
+    LetIn !i !(GNode i) !(GNode i)
+  | -- Data constructor.
+    Data !i !Tag ![GNode i]
+  | -- One-level case matching on the tag of a data constructor: `Case value
+    -- branches`. `Case` is lazy: only the selected branch is evaluated. Lazy `if`
+    -- can be implemented by a case on a boolean.
+    Case !i !(GNode i) ![CaseBranch i]
+  | -- Execution only: `LambdaClosure env body`
+    LambdaClosure !i ![GNode i] !(GNode i)
+
+-- Other things we might need in the future:
+-- - laziness annotations (converting these to closures should be done further
+--   down the pipeline)
+-- - primitive record projections (efficiency of evaluation / code generation)
+-- - Fix and CoFix (anonymous recursion / co-recursion)
+
+data Constant
+  = ConstInteger !Integer
+  | ConstBool !Bool
+  | -- A hole. It's a unit for the purposes of evaluation.
+    ConstHole
+
+-- Other things we might need in the future:
+-- - ConstFloat
+-- - ConstString
+-- - ConstType: computationally a unit, corresponds to a type argument; the
+--   attached an info stores the type information; erased further down the
+--   pipeline
+
+data CaseBranch i = CaseBranch !Tag !(GNode i)
+
+{---------------------------------------------------------------------------------}
+{- General recursors on GNode  -}
+
+-- i: info type
+-- a: top-down accumulator type
+-- b: result type (bottom-up accumulator)
+data GNodeSig i a b = GNodeSig
+  { _fVar :: a -> i -> Index -> b,
+    _fIdent :: a -> i -> Symbol -> b,
+    _fBuiltin :: a -> i -> Symbol -> b,
+    _fConstInteger :: a -> i -> Integer -> b,
+    _fConstBool :: a -> i -> Bool -> b,
+    _fConstHole :: a -> i -> b,
+    _fApp :: a -> i -> GNode i -> b -> [GNode i] -> [b] -> b,
+    _fLambda :: a -> i -> GNode i -> b -> b,
+    _fLetIn :: a -> i -> GNode i -> b -> GNode i -> b -> b,
+    _fData :: a -> i -> Tag -> [GNode i] -> [b] -> b,
+    _fCase :: a -> i -> GNode i -> b -> [CaseBranch i] -> [b] -> b,
+    _fLambdaClosure :: a -> i -> [GNode i] -> [b] -> GNode i -> b -> b
+  }
+
+makeLenses ''GNodeSig
+
+-- `recurse f sig acc` recurses through the graph, using `sig` to accumulate
+-- results bottom-up, `f` to accumulate values top-down on the current path with
+-- `a` the initial top-down accumulator value
+recurse :: GNodeSig i a b -> (a -> GNode i -> a) -> a -> GNode i -> b
+recurse sig f a n = case n of
+  Var i idx -> (sig ^. fVar) a i idx
+  Ident i sym -> (sig ^. fIdent) a i sym
+  Builtin i sym -> (sig ^. fBuiltin) a i sym
+  Literal i (ConstInteger int) -> (sig ^. fConstInteger) a i int
+  Literal i (ConstBool b) -> (sig ^. fConstBool) a i b
+  Literal i ConstHole -> (sig ^. fConstHole) a i
+  App i l args -> (sig ^. fApp) a i l (goRec l) args (map goRec args)
+  Lambda i body -> (sig ^. fLambda) a i body (goRec body)
+  LetIn i value body -> (sig ^. fLetIn) a i value (goRec value) body (goRec body)
+  Data i tag args -> (sig ^. fData) a i tag args (map goRec args)
+  Case i value branches -> (sig ^. fCase) a i value (goRec value) branches (map (\(CaseBranch _ br) -> goRec br) branches)
+  LambdaClosure i env body -> (sig ^. fLambdaClosure) a i env (map goRec env) body (goRec body)
+  where
+    goRec = recurse sig f (f a n)
+
+-- recurse with binding info
+recurseWithBindingInfo :: i' -> (i -> i' -> i') -> GNodeSig i (i', a) b -> (i' -> a -> GNode i -> a) -> a -> GNode i -> b
+recurseWithBindingInfo nil cs sig f acc = recurse sig f' (nil, acc)
+  where
+    f' (is, a) n = case n of
+      Lambda i _ -> (cs i is, f is a n)
+      LetIn i _ _ -> (cs i is, f is a n)
+      LambdaClosure i _ _ -> (cs i is, f is a n)
+      _ -> (is, f is a n)
+
+recurseB :: GNodeSig i ([i], a) b -> ([i] -> a -> GNode i -> a) -> a -> GNode i -> b
+recurseB = recurseWithBindingInfo [] (:)
+
+recurseN :: GNodeSig i (Int, a) b -> (Int -> a -> GNode i -> a) -> a -> GNode i -> b
+recurseN = recurseWithBindingInfo 0 (const (+ 1))
+
+nmapSig :: (a -> GNode i -> GNode i) -> GNodeSig i a (GNode i)
+nmapSig f =
+  GNodeSig
+    {
+      _fVar = \a i idx -> f a (Var i idx),
+      _fIdent = \a i sym -> f a (Ident i sym),
+      _fBuiltin = \a i sym -> f a (Ident i sym),
+      _fConstInteger = \a i int -> f a (Literal i (ConstInteger int)),
+      _fConstBool = \a i b -> f a (Literal i (ConstBool b)),
+      _fConstHole = \a i -> f a (Literal i ConstHole),
+      _fApp = \a i _ l' _ args' -> f a (App i l' args'),
+      _fLambda = \a i _ body' -> f a (Lambda i body'),
+      _fLetIn = \a i _ value' _ body' -> f a (LetIn i value' body'),
+      _fData = \a i tag _ args' -> f a (Data i tag args'),
+      _fCase = \a i _ value' bs bs' -> f a (Case i value' (zipWithExact (\(CaseBranch tag _) br' -> CaseBranch tag br') bs bs')),
+      _fLambdaClosure = \a i _ env' _ body' -> f a (LambdaClosure i env' body')
+    }
+
+nmap :: (GNode i -> GNode i) -> GNode i -> GNode i
+nmap f = recurse (nmapSig (const f)) (\_ _ -> ()) ()
+
+nmapB :: ([i] -> GNode i -> GNode i) -> GNode i -> GNode i
+nmapB f = recurseB (nmapSig (f . fst)) (\_ _ _ -> ()) ()
+
+nmapN :: (Int -> GNode i -> GNode i) -> GNode i -> GNode i
+nmapN f = recurseN (nmapSig (f . fst)) (\_ _ _ -> ()) ()

From eb9f8b8ea0e0ae53e54de6124304655e198e7d34 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Mon, 25 Jul 2022 11:50:35 +0200
Subject: [PATCH 02/85] new recursors

---
 src/Juvix/Core/GNode.hs | 184 +++++++++++++++++++++++-----------------
 1 file changed, 104 insertions(+), 80 deletions(-)

diff --git a/src/Juvix/Core/GNode.hs b/src/Juvix/Core/GNode.hs
index 493082d40c..1328723bcd 100644
--- a/src/Juvix/Core/GNode.hs
+++ b/src/Juvix/Core/GNode.hs
@@ -5,6 +5,7 @@ module Juvix.Core.GNode where
   general recursors on it.
 -}
 
+import Data.Functor.Identity
 import Juvix.Prelude
 
 {---------------------------------------------------------------------------------}
@@ -20,7 +21,7 @@ type Symbol = Word
 type Tag = Word
 
 -- de Bruijn index
-type Index = Word
+type Index = Int
 
 -- `GNode i` is the type of nodes in the program graph, where `i` is the info
 -- type. `GNode` itself contains only runtime-relevant information.
@@ -39,7 +40,7 @@ data GNode i
     -- them and can treat them specially.
     Builtin !i !Symbol
   | Literal !i {-# UNPACK #-} !Constant
-  | App !i !(GNode i) ![GNode i]
+  | App !i !(GNode i) !(GNode i)
   | Lambda !i !(GNode i)
   | -- `let x := value in body` is not reducible to lambda + application for the purposes
     -- of ML-polymorphic / dependent type checking or code generation!
@@ -77,85 +78,108 @@ data CaseBranch i = CaseBranch !Tag !(GNode i)
 {---------------------------------------------------------------------------------}
 {- General recursors on GNode  -}
 
--- i: info type
--- a: top-down accumulator type
--- b: result type (bottom-up accumulator)
-data GNodeSig i a b = GNodeSig
-  { _fVar :: a -> i -> Index -> b,
-    _fIdent :: a -> i -> Symbol -> b,
-    _fBuiltin :: a -> i -> Symbol -> b,
-    _fConstInteger :: a -> i -> Integer -> b,
-    _fConstBool :: a -> i -> Bool -> b,
-    _fConstHole :: a -> i -> b,
-    _fApp :: a -> i -> GNode i -> b -> [GNode i] -> [b] -> b,
-    _fLambda :: a -> i -> GNode i -> b -> b,
-    _fLetIn :: a -> i -> GNode i -> b -> GNode i -> b -> b,
-    _fData :: a -> i -> Tag -> [GNode i] -> [b] -> b,
-    _fCase :: a -> i -> GNode i -> b -> [CaseBranch i] -> [b] -> b,
-    _fLambdaClosure :: a -> i -> [GNode i] -> [b] -> GNode i -> b -> b
+-- a collector collects information top-down on a single path in the program
+-- tree
+data Collector a c = Collector
+  {
+    _cEmpty :: c,
+    _cCollect :: a -> c -> c
   }
 
-makeLenses ''GNodeSig
-
--- `recurse f sig acc` recurses through the graph, using `sig` to accumulate
--- results bottom-up, `f` to accumulate values top-down on the current path with
--- `a` the initial top-down accumulator value
-recurse :: GNodeSig i a b -> (a -> GNode i -> a) -> a -> GNode i -> b
-recurse sig f a n = case n of
-  Var i idx -> (sig ^. fVar) a i idx
-  Ident i sym -> (sig ^. fIdent) a i sym
-  Builtin i sym -> (sig ^. fBuiltin) a i sym
-  Literal i (ConstInteger int) -> (sig ^. fConstInteger) a i int
-  Literal i (ConstBool b) -> (sig ^. fConstBool) a i b
-  Literal i ConstHole -> (sig ^. fConstHole) a i
-  App i l args -> (sig ^. fApp) a i l (goRec l) args (map goRec args)
-  Lambda i body -> (sig ^. fLambda) a i body (goRec body)
-  LetIn i value body -> (sig ^. fLetIn) a i value (goRec value) body (goRec body)
-  Data i tag args -> (sig ^. fData) a i tag args (map goRec args)
-  Case i value branches -> (sig ^. fCase) a i value (goRec value) branches (map (\(CaseBranch _ br) -> goRec br) branches)
-  LambdaClosure i env body -> (sig ^. fLambdaClosure) a i env (map goRec env) body (goRec body)
-  where
-    goRec = recurse sig f (f a n)
+makeLenses ''Collector
+
+unitCollector :: Collector a ()
+unitCollector = Collector () (\_ _ -> ())
 
--- recurse with binding info
-recurseWithBindingInfo :: i' -> (i -> i' -> i') -> GNodeSig i (i', a) b -> (i' -> a -> GNode i -> a) -> a -> GNode i -> b
-recurseWithBindingInfo nil cs sig f acc = recurse sig f' (nil, acc)
+bindingCollector :: Collector i c -> Collector (GNode i) c
+bindingCollector coll = Collector (coll ^. cEmpty) collect
+  where
+    collect n c = case n of
+      Lambda i _ -> (coll ^. cCollect) i c
+      LetIn i _ _ -> (coll ^. cCollect) i c
+      LambdaClosure i _ _ -> (coll ^. cCollect) i c
+      _ -> c
+
+-- `umapG` maps the nodes bottom-up, i.e., when invoking the mapper function the
+-- recursive subnodes have already been mapped
+umapG :: Monad m => Collector (GNode i) c -> (c -> GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
+umapG coll f = go (coll ^. cEmpty)
+  where
+    go c n = case n of
+      App i l r -> f c =<< (App i <$> go c' l <*> go c' r)
+      Lambda i body -> f c . Lambda i =<< go c' body
+      LetIn i value body -> f c =<< (LetIn i <$> go c' value <*> go c' body)
+      Data i tag args -> f c . Data i tag =<< mapM (go c') args
+      Case i value bs -> f c =<< (Case i <$> go c' value <*> mapM (\(CaseBranch tag br) -> CaseBranch tag <$> go c' br) bs)
+      LambdaClosure i env body -> f c =<< (LambdaClosure i <$> mapM (go c') env <*> go c' body)
+      _ -> f c n
+      where
+        c' = (coll ^. cCollect) n c
+
+umapM :: Monad m => (GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
+umapM f = umapG unitCollector (const f)
+
+umapMB :: Monad m => ([i] -> GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
+umapMB f = umapG (bindingCollector (Collector [] (:))) f
+
+umapMN :: Monad m => (Index -> GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
+umapMN f = umapG (bindingCollector (Collector 0 (const (+ 1)))) f
+
+umap :: (GNode i -> GNode i) -> GNode i -> GNode i
+umap f n = runIdentity $ umapM (return . f) n
+
+umapB :: ([i] -> GNode i -> GNode i) -> GNode i -> GNode i
+umapB f n = runIdentity $ umapMB (\is -> return . f is) n
+
+umapN :: (Index -> GNode i -> GNode i) -> GNode i -> GNode i
+umapN f n = runIdentity $ umapMN (\idx -> return . f idx) n
+
+-- `dmapG` maps the nodes top-down
+dmapG :: Monad m => Collector (GNode i) c -> (c -> GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
+dmapG coll f = go (coll ^. cEmpty)
+  where
+    go c n = do
+      n' <- f c n
+      let c' = (coll ^. cCollect) n' c
+      case n' of
+        App i l r -> App i <$> go c' l <*> go c' r
+        Lambda i body -> Lambda i <$> go c' body
+        LetIn i value body -> LetIn i <$> go c' value <*> go c' body
+        Data i tag args -> Data i tag <$> mapM (go c') args
+        Case i value bs -> Case i <$> go c' value <*> mapM (\(CaseBranch tag br) -> CaseBranch tag <$> go c' br) bs
+        LambdaClosure i env body -> LambdaClosure i <$> mapM (go c') env <*> go c' body
+        _ -> return n'
+
+dmapM :: Monad m => (GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
+dmapM f = dmapG unitCollector (const f)
+
+dmapMB :: Monad m => ([i] -> GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
+dmapMB f = dmapG (bindingCollector (Collector [] (:))) f
+
+dmapMN :: Monad m => (Index -> GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
+dmapMN f = dmapG (bindingCollector (Collector 0 (const (+ 1)))) f
+
+dmap :: (GNode i -> GNode i) -> GNode i -> GNode i
+dmap f n = runIdentity $ dmapM (return . f) n
+
+dmapB :: ([i] -> GNode i -> GNode i) -> GNode i -> GNode i
+dmapB f n = runIdentity $ dmapMB (\is -> return . f is) n
+
+dmapN :: (Index -> GNode i -> GNode i) -> GNode i -> GNode i
+dmapN f n = runIdentity $ dmapMN (\idx -> return . f idx) n
+
+-- `ufoldG` folds the tree bottom-up; `uplus` combines the values - it should be
+-- commutative and associative
+ufoldG :: Monad m => Collector (GNode i) c -> (a -> a -> a) -> (c -> GNode i -> m a) -> GNode i -> m a
+ufoldG coll uplus f = go (coll ^. cEmpty)
   where
-    f' (is, a) n = case n of
-      Lambda i _ -> (cs i is, f is a n)
-      LetIn i _ _ -> (cs i is, f is a n)
-      LambdaClosure i _ _ -> (cs i is, f is a n)
-      _ -> (is, f is a n)
-
-recurseB :: GNodeSig i ([i], a) b -> ([i] -> a -> GNode i -> a) -> a -> GNode i -> b
-recurseB = recurseWithBindingInfo [] (:)
-
-recurseN :: GNodeSig i (Int, a) b -> (Int -> a -> GNode i -> a) -> a -> GNode i -> b
-recurseN = recurseWithBindingInfo 0 (const (+ 1))
-
-nmapSig :: (a -> GNode i -> GNode i) -> GNodeSig i a (GNode i)
-nmapSig f =
-  GNodeSig
-    {
-      _fVar = \a i idx -> f a (Var i idx),
-      _fIdent = \a i sym -> f a (Ident i sym),
-      _fBuiltin = \a i sym -> f a (Ident i sym),
-      _fConstInteger = \a i int -> f a (Literal i (ConstInteger int)),
-      _fConstBool = \a i b -> f a (Literal i (ConstBool b)),
-      _fConstHole = \a i -> f a (Literal i ConstHole),
-      _fApp = \a i _ l' _ args' -> f a (App i l' args'),
-      _fLambda = \a i _ body' -> f a (Lambda i body'),
-      _fLetIn = \a i _ value' _ body' -> f a (LetIn i value' body'),
-      _fData = \a i tag _ args' -> f a (Data i tag args'),
-      _fCase = \a i _ value' bs bs' -> f a (Case i value' (zipWithExact (\(CaseBranch tag _) br' -> CaseBranch tag br') bs bs')),
-      _fLambdaClosure = \a i _ env' _ body' -> f a (LambdaClosure i env' body')
-    }
-
-nmap :: (GNode i -> GNode i) -> GNode i -> GNode i
-nmap f = recurse (nmapSig (const f)) (\_ _ -> ()) ()
-
-nmapB :: ([i] -> GNode i -> GNode i) -> GNode i -> GNode i
-nmapB f = recurseB (nmapSig (f . fst)) (\_ _ _ -> ()) ()
-
-nmapN :: (Int -> GNode i -> GNode i) -> GNode i -> GNode i
-nmapN f = recurseN (nmapSig (f . fst)) (\_ _ _ -> ()) ()
+    go c n = case n of
+      App _ l r -> uplus <$> f c n <*> (uplus <$> go c' l <*> go c' r)
+      Lambda _ body -> uplus <$> f c n <*> go c' body
+      LetIn _ value body -> uplus <$> f c n <*> (uplus <$> go c' value <*> go c' body)
+      Data _ _ args -> foldr (liftM2 uplus . go c') (f c n) args
+      Case _ value bs -> uplus <$> f c n <*> foldr (liftM2 uplus . (\(CaseBranch _ br) -> go c' br)) (go c' value) bs
+      LambdaClosure _ env body -> uplus <$> f c n <*> foldr (liftM2 uplus . go c') (go c' body) env
+      _ -> f c n
+      where
+        c' = (coll ^. cCollect) n c

From 853ab2aff3b906500de62d8f6e7f0326df4cd685 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Mon, 25 Jul 2022 17:27:24 +0200
Subject: [PATCH 03/85] recursors

---
 src/Juvix/Core/Builtins.hs |  14 +++++
 src/Juvix/Core/GNode.hs    | 121 ++++++++++++++++++++++++++++++++++---
 2 files changed, 125 insertions(+), 10 deletions(-)

diff --git a/src/Juvix/Core/Builtins.hs b/src/Juvix/Core/Builtins.hs
index ef593238fc..03b919e06e 100644
--- a/src/Juvix/Core/Builtins.hs
+++ b/src/Juvix/Core/Builtins.hs
@@ -1,2 +1,16 @@
 module Juvix.Core.Builtins where
 
+-- Builtin operations which the evaluator and the code generator treat
+-- specially.
+data Builtin
+  = BuiltinIntAdd
+  | BuiltinIntSub
+  | BuiltinIntMul
+  | BuiltinIntDiv
+  | BuiltinIntEq
+  | BuiltinIntLt
+  | BuiltinIntGt
+  | BuiltinIntLe
+  | BuiltinIntGe
+  | BuiltinBoolAnd
+  | BuiltinBoolOr
diff --git a/src/Juvix/Core/GNode.hs b/src/Juvix/Core/GNode.hs
index 1328723bcd..00c2aff785 100644
--- a/src/Juvix/Core/GNode.hs
+++ b/src/Juvix/Core/GNode.hs
@@ -6,7 +6,9 @@ module Juvix.Core.GNode where
 -}
 
 import Data.Functor.Identity
+import Data.HashSet qualified as HashSet
 import Juvix.Prelude
+import Juvix.Core.Builtins
 
 {---------------------------------------------------------------------------------}
 {- Program graph datatype -}
@@ -33,12 +35,10 @@ data GNode i
   | -- Global identifier of a function (with corresponding `GNode` in the global
     -- context).
     Ident !i !Symbol
-  | -- Global identifier of an external / builtin (no corresponding GNode). For
-    -- example, basic arithmetic operations go into `Builtin`. The numeric
-    -- symbol values for basic builtin operations (e.g. arithmetic) should be
-    -- fixed in Core, so that the evaluator and the code generator know about
-    -- them and can treat them specially.
-    Builtin !i !Symbol
+  | -- A builtin with no corresponding GNode, treated specially by the evaluator
+    -- and the code generator. For example, basic arithmetic operations go into
+    -- `Builtin`.
+    Builtin !i !Builtin
   | Literal !i {-# UNPACK #-} !Constant
   | App !i !(GNode i) !(GNode i)
   | Lambda !i !(GNode i)
@@ -59,6 +59,12 @@ data GNode i
 --   down the pipeline)
 -- - primitive record projections (efficiency of evaluation / code generation)
 -- - Fix and CoFix (anonymous recursion / co-recursion)
+-- - with dependent types, it might actually be more reasonable to have Pi as
+--   another node (because it's a binder); computationally it would be a unit,
+--   erased in further stages of the pipeline
+-- - with Pi a node, other basic type constructors should also be nodes:
+--   TypeIdent (named type identifier available in the global context, e.g.,
+--   inductive type), Universe
 
 data Constant
   = ConstInteger !Integer
@@ -70,8 +76,7 @@ data Constant
 -- - ConstFloat
 -- - ConstString
 -- - ConstType: computationally a unit, corresponds to a type argument; the
---   attached an info stores the type information; erased further down the
---   pipeline
+--   attached info stores the type information; erased further down the pipeline
 
 data CaseBranch i = CaseBranch !Tag !(GNode i)
 
@@ -81,8 +86,7 @@ data CaseBranch i = CaseBranch !Tag !(GNode i)
 -- a collector collects information top-down on a single path in the program
 -- tree
 data Collector a c = Collector
-  {
-    _cEmpty :: c,
+  { _cEmpty :: c,
     _cCollect :: a -> c -> c
   }
 
@@ -183,3 +187,100 @@ ufoldG coll uplus f = go (coll ^. cEmpty)
       _ -> f c n
       where
         c' = (coll ^. cCollect) n c
+
+ufoldM :: Monad m => (a -> a -> a) -> (GNode i -> m a) -> GNode i -> m a
+ufoldM uplus f = ufoldG unitCollector uplus (const f)
+
+ufoldMB :: Monad m => (a -> a -> a) -> ([i] -> GNode i -> m a) -> GNode i -> m a
+ufoldMB uplus f = ufoldG (bindingCollector (Collector [] (:))) uplus f
+
+ufoldMN :: Monad m => (a -> a -> a) -> (Index -> GNode i -> m a) -> GNode i -> m a
+ufoldMN uplus f = ufoldG (bindingCollector (Collector 0 (const (+ 1)))) uplus f
+
+ufold :: (a -> a -> a) -> (GNode i -> a) -> GNode i -> a
+ufold uplus f n = runIdentity $ ufoldM uplus (return . f) n
+
+ufoldB :: (a -> a -> a) -> ([i] -> GNode i -> a) -> GNode i -> a
+ufoldB uplus f n = runIdentity $ ufoldMB uplus (\is -> return . f is) n
+
+ufoldN :: (a -> a -> a) -> (Index -> GNode i -> a) -> GNode i -> a
+ufoldN uplus f n = runIdentity $ ufoldMN uplus (\idx -> return . f idx) n
+
+walk :: Monad m => (GNode i -> m ()) -> GNode i -> m ()
+walk = ufoldM mappend
+
+walkB :: Monad m => ([i] -> GNode i -> m ()) -> GNode i -> m ()
+walkB = ufoldMB mappend
+
+walkN :: Monad m => (Index -> GNode i -> m ()) -> GNode i -> m ()
+walkN = ufoldMN mappend
+
+gather :: (a -> GNode i -> a) -> a -> GNode i -> a
+gather f acc n = fst $ run $ runState acc (walk (\n' -> modify (`f` n')) n)
+
+gatherB :: ([i] -> a -> GNode i -> a) -> a -> GNode i -> a
+gatherB f acc n = fst $ run $ runState acc (walkB (\is n' -> modify (\a -> f is a n')) n)
+
+gatherN :: (Index -> a -> GNode i -> a) -> a -> GNode i -> a
+gatherN f acc n = fst $ run $ runState acc (walkN (\idx n' -> modify (\a -> f idx a n')) n)
+
+{---------------------------------------------------------------------------}
+{- useful functions implemented using general recursors -}
+
+isClosed :: GNode i -> Bool
+isClosed = ufoldN (&&) go
+  where
+    go :: Index -> GNode i -> Bool
+    go k = \case
+      Var _ idx | idx >= k -> False
+      _ -> True
+
+getFreeVars :: GNode i -> HashSet Index
+getFreeVars = gatherN go HashSet.empty
+  where
+    go :: Index -> HashSet Index -> GNode i -> HashSet Index
+    go k acc = \case
+      Var _ idx | idx >= k -> HashSet.insert (idx - k) acc
+      _ -> acc
+
+getIdents :: GNode i -> HashSet Symbol
+getIdents = gather go HashSet.empty
+  where
+    go :: HashSet Symbol -> GNode i -> HashSet Symbol
+    go acc = \case
+      Ident _ sym -> HashSet.insert sym acc
+      _ -> acc
+
+countFreeVarOccurrences :: Index -> GNode i -> Int
+countFreeVarOccurrences idx = gatherN go 0
+  where
+    go k acc = \case
+      Var _ idx' | idx' == idx + k -> acc + 1
+      _ -> acc
+
+-- increase all free variable indices by a given value
+shift :: Index -> GNode i -> GNode i
+shift m = umapN go
+  where
+    go k n = case n of
+      Var i idx | idx >= k -> Var i (idx + m)
+      _ -> n
+
+-- substitute a term t for the free variable with de Bruijn index 0, avoiding
+-- variable capture
+subst :: GNode i -> GNode i -> GNode i
+subst t = umapN go
+  where
+    go k n = case n of
+      Var _ idx | idx == k -> shift k t
+      _ -> n
+
+-- reduce all beta redexes present in a term (newly created redexes are not
+-- recursively reduced)
+reduceBeta :: GNode i -> GNode i
+reduceBeta = umap go
+  where
+    go :: GNode i -> GNode i
+    go n = case n of
+      App _ (Lambda _ body) arg -> subst arg body
+      _ -> n

From 7d69674cd0e993250179b855bc6d0b4ab74dbccd Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Mon, 25 Jul 2022 17:31:48 +0200
Subject: [PATCH 04/85] BuiltinOp

---
 src/Juvix/Core/Builtins.hs | 24 ++++++++++++------------
 src/Juvix/Core/GNode.hs    |  6 +++---
 2 files changed, 15 insertions(+), 15 deletions(-)

diff --git a/src/Juvix/Core/Builtins.hs b/src/Juvix/Core/Builtins.hs
index 03b919e06e..3c9b6f7077 100644
--- a/src/Juvix/Core/Builtins.hs
+++ b/src/Juvix/Core/Builtins.hs
@@ -2,15 +2,15 @@ module Juvix.Core.Builtins where
 
 -- Builtin operations which the evaluator and the code generator treat
 -- specially.
-data Builtin
-  = BuiltinIntAdd
-  | BuiltinIntSub
-  | BuiltinIntMul
-  | BuiltinIntDiv
-  | BuiltinIntEq
-  | BuiltinIntLt
-  | BuiltinIntGt
-  | BuiltinIntLe
-  | BuiltinIntGe
-  | BuiltinBoolAnd
-  | BuiltinBoolOr
+data BuiltinOp
+  = OpIntAdd
+  | OpIntSub
+  | OpIntMul
+  | OpIntDiv
+  | OpIntEq
+  | OpIntLt
+  | OpIntGt
+  | OpIntLe
+  | OpIntGe
+  | OpBoolAnd
+  | OpBoolOr
diff --git a/src/Juvix/Core/GNode.hs b/src/Juvix/Core/GNode.hs
index 00c2aff785..47de042131 100644
--- a/src/Juvix/Core/GNode.hs
+++ b/src/Juvix/Core/GNode.hs
@@ -7,13 +7,13 @@ module Juvix.Core.GNode where
 
 import Data.Functor.Identity
 import Data.HashSet qualified as HashSet
-import Juvix.Prelude
 import Juvix.Core.Builtins
+import Juvix.Prelude
 
 {---------------------------------------------------------------------------------}
 {- Program graph datatype -}
 
--- Consecutive symbol IDs for builtins and reachable user functions.
+-- Consecutive symbol IDs for reachable user functions.
 type Symbol = Word
 
 -- Tag of a constructor, uniquely identifying it. Tag values are consecutive and
@@ -38,7 +38,7 @@ data GNode i
   | -- A builtin with no corresponding GNode, treated specially by the evaluator
     -- and the code generator. For example, basic arithmetic operations go into
     -- `Builtin`.
-    Builtin !i !Builtin
+    Builtin !i !BuiltinOp
   | Literal !i {-# UNPACK #-} !Constant
   | App !i !(GNode i) !(GNode i)
   | Lambda !i !(GNode i)

From 73609106d234004643c47bc3eeb097f64d824782 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Mon, 25 Jul 2022 18:14:35 +0200
Subject: [PATCH 05/85] context draft

---
 src/Juvix/Core/Context.hs | 30 ++++++++++++++++++++++++++++++
 src/Juvix/Core/GNode.hs   |  2 +-
 src/Juvix/Core/Type.hs    |  3 +++
 3 files changed, 34 insertions(+), 1 deletion(-)
 create mode 100644 src/Juvix/Core/Type.hs

diff --git a/src/Juvix/Core/Context.hs b/src/Juvix/Core/Context.hs
index 5ced00226e..570c889d63 100644
--- a/src/Juvix/Core/Context.hs
+++ b/src/Juvix/Core/Context.hs
@@ -1,2 +1,32 @@
 module Juvix.Core.Context where
 
+import Juvix.Prelude
+import Juvix.Core.GNode
+import Juvix.Core.Type
+
+type IdentContext i = HashMap Symbol (GNode i)
+
+data Context i = Context
+  {
+    _identContext :: IdentContext i,
+    _identInfo :: IdentInfo,
+    _inductiveInfo :: i
+  }
+
+data IdentInfo = IdentInfo
+  {
+    _identName :: Text,
+    _identSymbol :: Symbol,
+    _identType :: CoreType,
+    _identArgsNum :: Int,
+    _identArgsInfo :: [ArgumentInfo]
+  }
+
+data ArgumentInfo = ArgumentInfo
+  {
+    _argName :: Text,
+    _argType :: CoreType,
+    _argIsImplicit :: Bool
+  }
+
+makeLenses ''Context
diff --git a/src/Juvix/Core/GNode.hs b/src/Juvix/Core/GNode.hs
index 47de042131..7254d15488 100644
--- a/src/Juvix/Core/GNode.hs
+++ b/src/Juvix/Core/GNode.hs
@@ -18,7 +18,7 @@ type Symbol = Word
 
 -- Tag of a constructor, uniquely identifying it. Tag values are consecutive and
 -- separate from symbol IDs. We might need fixed special tag values in Core for
--- common "builtin" constructors, e.g., lists, pairs, so that the code generator
+-- common "builtin" constructors, e.g., unit, lists, pairs, so that the code generator
 -- can treat them specially.
 type Tag = Word
 
diff --git a/src/Juvix/Core/Type.hs b/src/Juvix/Core/Type.hs
new file mode 100644
index 0000000000..534a9598e4
--- /dev/null
+++ b/src/Juvix/Core/Type.hs
@@ -0,0 +1,3 @@
+module Juvix.Core.Type where
+
+data CoreType

From 21baec6124a9e6d1efc28f3bb8e57ede8f1f7c41 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Tue, 26 Jul 2022 12:17:16 +0200
Subject: [PATCH 06/85] recursors & context

---
 src/Juvix/Core/Builtins.hs |  13 +++
 src/Juvix/Core/Context.hs  |  60 ++++++++--
 src/Juvix/Core/GNode.hs    | 219 ++++++++++++++++++++++++++-----------
 src/Juvix/Core/Type.hs     |  24 +++-
 4 files changed, 239 insertions(+), 77 deletions(-)

diff --git a/src/Juvix/Core/Builtins.hs b/src/Juvix/Core/Builtins.hs
index 3c9b6f7077..91b0139a7c 100644
--- a/src/Juvix/Core/Builtins.hs
+++ b/src/Juvix/Core/Builtins.hs
@@ -14,3 +14,16 @@ data BuiltinOp
   | OpIntGe
   | OpBoolAnd
   | OpBoolOr
+  | OpListHead
+  | OpListTail
+  | OpPairFst
+  | OpPairSnd
+
+-- Builtin data tags
+data BuiltinDataTag =
+    TagZero
+  | TagSucc
+  | TagUnit
+  | TagNil
+  | TagCons
+  | TagPair
diff --git a/src/Juvix/Core/Context.hs b/src/Juvix/Core/Context.hs
index 570c889d63..d318e15151 100644
--- a/src/Juvix/Core/Context.hs
+++ b/src/Juvix/Core/Context.hs
@@ -1,32 +1,68 @@
 module Juvix.Core.Context where
 
-import Juvix.Prelude
 import Juvix.Core.GNode
 import Juvix.Core.Type
+import Juvix.Prelude
+import Juvix.Syntax.Abstract.Name
 
 type IdentContext i = HashMap Symbol (GNode i)
 
 data Context i = Context
-  {
-    _identContext :: IdentContext i,
-    _identInfo :: IdentInfo,
-    _inductiveInfo :: i
+  { _identContext :: IdentContext i,
+    _identInfo :: HashMap Symbol IdentInfo,
+    -- We reuse `Name` for runtime-irrelevant identifiers (inductive type names,
+    -- axiom names, etc). We shouldn't do this for Symbol and Tag, because we
+    -- need them "small", consecutive and separate for the code generator.
+    -- Discuss: advantages/disadvantages of doing this separation later in the
+    -- pipeline.
+    _inductiveInfo :: HashMap Name InductiveInfo,
+    _constructorInfo :: HashMap Tag ConstructorInfo,
+    _axiomInfo :: HashMap Name AxiomInfo
   }
 
 data IdentInfo = IdentInfo
-  {
-    _identName :: Text,
+  { _identName :: Name,
     _identSymbol :: Symbol,
-    _identType :: CoreType,
-    _identArgsNum :: Int,
+    _identType :: Type,
     _identArgsInfo :: [ArgumentInfo]
   }
 
 data ArgumentInfo = ArgumentInfo
-  {
-    _argName :: Text,
-    _argType :: CoreType,
+  { _argName :: Name,
+    _argType :: Type,
     _argIsImplicit :: Bool
+    -- future: _argIsLazy :: Bool
+  }
+
+data InductiveInfo = InductiveInfo
+  { _inductiveName :: Name,
+    _inductiveKind :: Type,
+    _inductiveConstructors :: [ConstructorInfo],
+    _inductiveParams :: [ParameterInfo],
+    _inductivePositive :: Bool
+  }
+
+data ConstructorInfo = ConstructorInfo
+  { _constructorName :: Name,
+    _constructorTag :: Tag,
+    _constructorType :: Type
+  }
+
+data ParameterInfo = ParameterInfo
+  { _paramName :: Name,
+    _paramKind :: Type,
+    _paramIsImplicit :: Bool
+  }
+
+data AxiomInfo = AxiomInfo
+  { _axiomName :: Name,
+    _axiomType :: Type
   }
 
 makeLenses ''Context
+makeLenses ''IdentInfo
+makeLenses ''ArgumentInfo
+makeLenses ''InductiveInfo
+makeLenses ''ConstructorInfo
+makeLenses ''ParameterInfo
+makeLenses ''AxiomInfo
diff --git a/src/Juvix/Core/GNode.hs b/src/Juvix/Core/GNode.hs
index 7254d15488..d00517589f 100644
--- a/src/Juvix/Core/GNode.hs
+++ b/src/Juvix/Core/GNode.hs
@@ -17,10 +17,10 @@ import Juvix.Prelude
 type Symbol = Word
 
 -- Tag of a constructor, uniquely identifying it. Tag values are consecutive and
--- separate from symbol IDs. We might need fixed special tag values in Core for
--- common "builtin" constructors, e.g., unit, lists, pairs, so that the code generator
--- can treat them specially.
-type Tag = Word
+-- separate from symbol IDs. We might need fixed special tags in Core for common
+-- "builtin" constructors, e.g., unit, nat, lists, pairs, so that the code
+-- generator can treat them specially.
+data Tag = BuiltinTag BuiltinDataTag | UserTag Word
 
 -- de Bruijn index
 type Index = Int
@@ -39,7 +39,11 @@ data GNode i
     -- and the code generator. For example, basic arithmetic operations go into
     -- `Builtin`.
     Builtin !i !BuiltinOp
-  | Literal !i {-# UNPACK #-} !Constant
+  | ConstValue !i {-# UNPACK #-} !Constant
+  | -- A hole. It's a unit for the purposes of evaluation.
+    Hole !i
+  | -- An axiom. Computationally a unit.
+    Axiom !i
   | App !i !(GNode i) !(GNode i)
   | Lambda !i !(GNode i)
   | -- `let x := value in body` is not reducible to lambda + application for the purposes
@@ -55,9 +59,9 @@ data GNode i
     LambdaClosure !i ![GNode i] !(GNode i)
 
 -- Other things we might need in the future:
--- - laziness annotations (converting these to closures should be done further
---   down the pipeline)
--- - primitive record projections (efficiency of evaluation / code generation)
+-- - laziness annotations (converting these to closures/thunks should be done
+--   further down the pipeline)
+-- - primitive record projections (efficiency of evaluation / generated code)
 -- - Fix and CoFix (anonymous recursion / co-recursion)
 -- - with dependent types, it might actually be more reasonable to have Pi as
 --   another node (because it's a binder); computationally it would be a unit,
@@ -69,17 +73,59 @@ data GNode i
 data Constant
   = ConstInteger !Integer
   | ConstBool !Bool
-  | -- A hole. It's a unit for the purposes of evaluation.
-    ConstHole
 
 -- Other things we might need in the future:
 -- - ConstFloat
 -- - ConstString
--- - ConstType: computationally a unit, corresponds to a type argument; the
---   attached info stores the type information; erased further down the pipeline
 
 data CaseBranch i = CaseBranch !Tag !(GNode i)
 
+{---------------------------------------------------------------------------------}
+{- Info -}
+
+getInfo :: GNode i -> i
+getInfo = \case
+  Var i _ -> i
+  Ident i _ -> i
+  Builtin i _ -> i
+  ConstValue i _ -> i
+  Hole i -> i
+  Axiom i -> i
+  App i _ _ -> i
+  Lambda i _ -> i
+  LetIn i _ _ -> i
+  Data i _ _ -> i
+  Case i _ _ -> i
+  LambdaClosure i _ _ -> i
+
+modifyInfoM :: Applicative m => (i -> m i) -> GNode i -> m (GNode i)
+modifyInfoM f = \case
+  Var i idx -> Var <$> f i <*> pure idx
+  Ident i sym -> Ident <$> f i <*> pure sym
+  Builtin i op -> Builtin <$> f i <*> pure op
+  ConstValue i v -> ConstValue <$> f i <*> pure v
+  Hole i -> Hole <$> f i
+  Axiom i -> Axiom <$> f i
+  App i l r -> App <$> f i <*> pure l <*> pure r
+  Lambda i b -> Lambda <$> f i <*> pure b
+  LetIn i v b -> LetIn <$> f i <*> pure v <*> pure b
+  Data i tag args -> Data <$> f i <*> pure tag <*> pure args
+  Case i v bs -> Case <$> f i <*> pure v <*> pure bs
+  LambdaClosure i env b -> LambdaClosure <$> f i <*> pure env <*> pure b
+
+modifyInfo :: (i -> i) -> GNode i -> GNode i
+modifyInfo f n = runIdentity $ modifyInfoM (pure . f) n
+
+-- The info type should be functorial in GNode (especially with dependent types,
+-- we will want to store nodes inside the info annotations).
+class GNodeFunctor i where
+  nmapM :: (GNode i -> m (GNode i)) -> i -> m i
+
+class GNodeFoldable i where
+  nfoldM :: (a -> a -> a) -> (GNode i -> m a) -> i -> m a
+
+class (GNodeFunctor i, GNodeFoldable i) => GNodeInfo i
+
 {---------------------------------------------------------------------------------}
 {- General recursors on GNode  -}
 
@@ -106,44 +152,64 @@ bindingCollector coll = Collector (coll ^. cEmpty) collect
 
 -- `umapG` maps the nodes bottom-up, i.e., when invoking the mapper function the
 -- recursive subnodes have already been mapped
-umapG :: Monad m => Collector (GNode i) c -> (c -> GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
+umapG ::
+  forall i c m.
+  (Monad m, GNodeFunctor i) =>
+  Collector (GNode i) c ->
+  (c -> GNode i -> m (GNode i)) ->
+  GNode i ->
+  m (GNode i)
 umapG coll f = go (coll ^. cEmpty)
   where
-    go c n = case n of
-      App i l r -> f c =<< (App i <$> go c' l <*> go c' r)
-      Lambda i body -> f c . Lambda i =<< go c' body
-      LetIn i value body -> f c =<< (LetIn i <$> go c' value <*> go c' body)
-      Data i tag args -> f c . Data i tag =<< mapM (go c') args
-      Case i value bs -> f c =<< (Case i <$> go c' value <*> mapM (\(CaseBranch tag br) -> CaseBranch tag <$> go c' br) bs)
-      LambdaClosure i env body -> f c =<< (LambdaClosure i <$> mapM (go c') env <*> go c' body)
-      _ -> f c n
+    go :: c -> GNode i -> m (GNode i)
+    go c n = do
+      n' <- modifyInfoM (nmapM (go c)) n
+      case n' of
+        App i l r -> f c =<< (App i <$> go c' l <*> go c' r)
+        Lambda i body -> f c . Lambda i =<< go c' body
+        LetIn i value body -> f c =<< (LetIn i <$> go c' value <*> go c' body)
+        Data i tag args -> f c . Data i tag =<< mapM (go c') args
+        Case i value bs -> f c =<< (Case i <$> go c' value <*> mapM (\(CaseBranch tag br) -> CaseBranch tag <$> go c' br) bs)
+        LambdaClosure i env body -> f c =<< (LambdaClosure i <$> mapM (go c') env <*> go c' body)
+        _ -> f c n'
       where
         c' = (coll ^. cCollect) n c
 
-umapM :: Monad m => (GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
+-- should there be n' here?
+
+umapM :: (Monad m, GNodeFunctor i) => (GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
 umapM f = umapG unitCollector (const f)
 
-umapMB :: Monad m => ([i] -> GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
+umapMB :: (Monad m, GNodeFunctor i) => ([i] -> GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
 umapMB f = umapG (bindingCollector (Collector [] (:))) f
 
-umapMN :: Monad m => (Index -> GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
+umapMN :: (Monad m, GNodeFunctor i) => (Index -> GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
 umapMN f = umapG (bindingCollector (Collector 0 (const (+ 1)))) f
 
-umap :: (GNode i -> GNode i) -> GNode i -> GNode i
+umap :: GNodeFunctor i => (GNode i -> GNode i) -> GNode i -> GNode i
 umap f n = runIdentity $ umapM (return . f) n
 
-umapB :: ([i] -> GNode i -> GNode i) -> GNode i -> GNode i
+umapB :: GNodeFunctor i => ([i] -> GNode i -> GNode i) -> GNode i -> GNode i
 umapB f n = runIdentity $ umapMB (\is -> return . f is) n
 
-umapN :: (Index -> GNode i -> GNode i) -> GNode i -> GNode i
+umapN :: GNodeFunctor i => (Index -> GNode i -> GNode i) -> GNode i -> GNode i
 umapN f n = runIdentity $ umapMN (\idx -> return . f idx) n
 
 -- `dmapG` maps the nodes top-down
-dmapG :: Monad m => Collector (GNode i) c -> (c -> GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
+dmapG ::
+  forall i c m.
+  (Monad m, GNodeFunctor i) =>
+  Collector (GNode i) c ->
+  ( c ->
+    GNode i ->
+    m (GNode i)
+  ) ->
+  GNode i ->
+  m (GNode i)
 dmapG coll f = go (coll ^. cEmpty)
   where
     go c n = do
-      n' <- f c n
+      n' <- modifyInfoM (nmapM (go c)) =<< f c n
       let c' = (coll ^. cCollect) n' c
       case n' of
         App i l r -> App i <$> go c' l <*> go c' r
@@ -154,80 +220,89 @@ dmapG coll f = go (coll ^. cEmpty)
         LambdaClosure i env body -> LambdaClosure i <$> mapM (go c') env <*> go c' body
         _ -> return n'
 
-dmapM :: Monad m => (GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
+dmapM :: (Monad m, GNodeFunctor i) => (GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
 dmapM f = dmapG unitCollector (const f)
 
-dmapMB :: Monad m => ([i] -> GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
+dmapMB :: (Monad m, GNodeFunctor i) => ([i] -> GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
 dmapMB f = dmapG (bindingCollector (Collector [] (:))) f
 
-dmapMN :: Monad m => (Index -> GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
+dmapMN :: (Monad m, GNodeFunctor i) => (Index -> GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
 dmapMN f = dmapG (bindingCollector (Collector 0 (const (+ 1)))) f
 
-dmap :: (GNode i -> GNode i) -> GNode i -> GNode i
+dmap :: GNodeFunctor i => (GNode i -> GNode i) -> GNode i -> GNode i
 dmap f n = runIdentity $ dmapM (return . f) n
 
-dmapB :: ([i] -> GNode i -> GNode i) -> GNode i -> GNode i
+dmapB :: GNodeFunctor i => ([i] -> GNode i -> GNode i) -> GNode i -> GNode i
 dmapB f n = runIdentity $ dmapMB (\is -> return . f is) n
 
-dmapN :: (Index -> GNode i -> GNode i) -> GNode i -> GNode i
+dmapN :: GNodeFunctor i => (Index -> GNode i -> GNode i) -> GNode i -> GNode i
 dmapN f n = runIdentity $ dmapMN (\idx -> return . f idx) n
 
 -- `ufoldG` folds the tree bottom-up; `uplus` combines the values - it should be
 -- commutative and associative
-ufoldG :: Monad m => Collector (GNode i) c -> (a -> a -> a) -> (c -> GNode i -> m a) -> GNode i -> m a
+ufoldG ::
+  forall i c a m.
+  (Monad m, GNodeFoldable i) =>
+  Collector (GNode i) c ->
+  (a -> a -> a) ->
+  (c -> GNode i -> m a) ->
+  GNode i ->
+  m a
 ufoldG coll uplus f = go (coll ^. cEmpty)
   where
+    go :: c -> GNode i -> m a
     go c n = case n of
-      App _ l r -> uplus <$> f c n <*> (uplus <$> go c' l <*> go c' r)
-      Lambda _ body -> uplus <$> f c n <*> go c' body
-      LetIn _ value body -> uplus <$> f c n <*> (uplus <$> go c' value <*> go c' body)
-      Data _ _ args -> foldr (liftM2 uplus . go c') (f c n) args
-      Case _ value bs -> uplus <$> f c n <*> foldr (liftM2 uplus . (\(CaseBranch _ br) -> go c' br)) (go c' value) bs
-      LambdaClosure _ env body -> uplus <$> f c n <*> foldr (liftM2 uplus . go c') (go c' body) env
-      _ -> f c n
+      App _ l r -> uplus <$> ma <*> (uplus <$> go c' l <*> go c' r)
+      Lambda _ body -> uplus <$> ma <*> go c' body
+      LetIn _ value body -> uplus <$> ma <*> (uplus <$> go c' value <*> go c' body)
+      Data _ _ args -> foldr (liftM2 uplus . go c') ma args
+      Case _ value bs -> uplus <$> ma <*> foldr (liftM2 uplus . (\(CaseBranch _ br) -> go c' br)) (go c' value) bs
+      LambdaClosure _ env body -> uplus <$> ma <*> foldr (liftM2 uplus . go c') (go c' body) env
+      _ -> ma
       where
         c' = (coll ^. cCollect) n c
+        ma = uplus <$> f c n <*> nfoldM uplus (go c) (getInfo n)
 
-ufoldM :: Monad m => (a -> a -> a) -> (GNode i -> m a) -> GNode i -> m a
+ufoldM :: (Monad m, GNodeFoldable i) => (a -> a -> a) -> (GNode i -> m a) -> GNode i -> m a
 ufoldM uplus f = ufoldG unitCollector uplus (const f)
 
-ufoldMB :: Monad m => (a -> a -> a) -> ([i] -> GNode i -> m a) -> GNode i -> m a
+ufoldMB :: (Monad m, GNodeFoldable i) => (a -> a -> a) -> ([i] -> GNode i -> m a) -> GNode i -> m a
 ufoldMB uplus f = ufoldG (bindingCollector (Collector [] (:))) uplus f
 
-ufoldMN :: Monad m => (a -> a -> a) -> (Index -> GNode i -> m a) -> GNode i -> m a
+ufoldMN :: (Monad m, GNodeFoldable i) => (a -> a -> a) -> (Index -> GNode i -> m a) -> GNode i -> m a
 ufoldMN uplus f = ufoldG (bindingCollector (Collector 0 (const (+ 1)))) uplus f
 
-ufold :: (a -> a -> a) -> (GNode i -> a) -> GNode i -> a
+ufold :: GNodeFoldable i => (a -> a -> a) -> (GNode i -> a) -> GNode i -> a
 ufold uplus f n = runIdentity $ ufoldM uplus (return . f) n
 
-ufoldB :: (a -> a -> a) -> ([i] -> GNode i -> a) -> GNode i -> a
+ufoldB :: GNodeFoldable i => (a -> a -> a) -> ([i] -> GNode i -> a) -> GNode i -> a
 ufoldB uplus f n = runIdentity $ ufoldMB uplus (\is -> return . f is) n
 
-ufoldN :: (a -> a -> a) -> (Index -> GNode i -> a) -> GNode i -> a
+ufoldN :: GNodeFoldable i => (a -> a -> a) -> (Index -> GNode i -> a) -> GNode i -> a
 ufoldN uplus f n = runIdentity $ ufoldMN uplus (\idx -> return . f idx) n
 
-walk :: Monad m => (GNode i -> m ()) -> GNode i -> m ()
+walk :: (Monad m, GNodeFoldable i) => (GNode i -> m ()) -> GNode i -> m ()
 walk = ufoldM mappend
 
-walkB :: Monad m => ([i] -> GNode i -> m ()) -> GNode i -> m ()
+walkB :: (Monad m, GNodeFoldable i) => ([i] -> GNode i -> m ()) -> GNode i -> m ()
 walkB = ufoldMB mappend
 
-walkN :: Monad m => (Index -> GNode i -> m ()) -> GNode i -> m ()
+walkN :: (Monad m, GNodeFoldable i) => (Index -> GNode i -> m ()) -> GNode i -> m ()
 walkN = ufoldMN mappend
 
-gather :: (a -> GNode i -> a) -> a -> GNode i -> a
+gather :: GNodeFoldable i => (a -> GNode i -> a) -> a -> GNode i -> a
 gather f acc n = fst $ run $ runState acc (walk (\n' -> modify (`f` n')) n)
 
-gatherB :: ([i] -> a -> GNode i -> a) -> a -> GNode i -> a
+gatherB :: GNodeFoldable i => ([i] -> a -> GNode i -> a) -> a -> GNode i -> a
 gatherB f acc n = fst $ run $ runState acc (walkB (\is n' -> modify (\a -> f is a n')) n)
 
-gatherN :: (Index -> a -> GNode i -> a) -> a -> GNode i -> a
+gatherN :: GNodeFoldable i => (Index -> a -> GNode i -> a) -> a -> GNode i -> a
 gatherN f acc n = fst $ run $ runState acc (walkN (\idx n' -> modify (\a -> f idx a n')) n)
 
 {---------------------------------------------------------------------------}
 {- useful functions implemented using general recursors -}
 
-isClosed :: GNode i -> Bool
+isClosed :: GNodeInfo i => GNode i -> Bool
 isClosed = ufoldN (&&) go
   where
     go :: Index -> GNode i -> Bool
@@ -235,7 +310,7 @@ isClosed = ufoldN (&&) go
       Var _ idx | idx >= k -> False
       _ -> True
 
-getFreeVars :: GNode i -> HashSet Index
+getFreeVars :: GNodeInfo i => GNode i -> HashSet Index
 getFreeVars = gatherN go HashSet.empty
   where
     go :: Index -> HashSet Index -> GNode i -> HashSet Index
@@ -243,7 +318,7 @@ getFreeVars = gatherN go HashSet.empty
       Var _ idx | idx >= k -> HashSet.insert (idx - k) acc
       _ -> acc
 
-getIdents :: GNode i -> HashSet Symbol
+getIdents :: GNodeInfo i => GNode i -> HashSet Symbol
 getIdents = gather go HashSet.empty
   where
     go :: HashSet Symbol -> GNode i -> HashSet Symbol
@@ -251,7 +326,7 @@ getIdents = gather go HashSet.empty
       Ident _ sym -> HashSet.insert sym acc
       _ -> acc
 
-countFreeVarOccurrences :: Index -> GNode i -> Int
+countFreeVarOccurrences :: GNodeInfo i => Index -> GNode i -> Int
 countFreeVarOccurrences idx = gatherN go 0
   where
     go k acc = \case
@@ -259,7 +334,7 @@ countFreeVarOccurrences idx = gatherN go 0
       _ -> acc
 
 -- increase all free variable indices by a given value
-shift :: Index -> GNode i -> GNode i
+shift :: GNodeInfo i => Index -> GNode i -> GNode i
 shift m = umapN go
   where
     go k n = case n of
@@ -268,19 +343,35 @@ shift m = umapN go
 
 -- substitute a term t for the free variable with de Bruijn index 0, avoiding
 -- variable capture
-subst :: GNode i -> GNode i -> GNode i
+subst :: GNodeInfo i => GNode i -> GNode i -> GNode i
 subst t = umapN go
   where
     go k n = case n of
       Var _ idx | idx == k -> shift k t
       _ -> n
 
--- reduce all beta redexes present in a term (newly created redexes are not
--- recursively reduced)
-reduceBeta :: GNode i -> GNode i
+-- reduce all beta redexes present in a term and a the ones created upwards
+-- (i.e., a "beta-development")
+reduceBeta :: forall i. GNodeInfo i => GNode i -> GNode i
 reduceBeta = umap go
   where
     go :: GNode i -> GNode i
     go n = case n of
       App _ (Lambda _ body) arg -> subst arg body
       _ -> n
+
+-- substitution of all free variables for values in a closed environment
+substEnv :: GNodeInfo i => [GNode i] -> GNode i -> GNode i
+substEnv env = umapN go
+  where
+    go k n = case n of
+      Var _ idx | idx >= k -> env !! k
+      _ -> n
+
+removeClosures :: forall i. GNodeInfo i => GNode i -> GNode i
+removeClosures = umap go
+  where
+    go :: GNode i -> GNode i
+    go n = case n of
+      LambdaClosure i env b -> substEnv env (Lambda i b)
+      _ -> n
diff --git a/src/Juvix/Core/Type.hs b/src/Juvix/Core/Type.hs
index 534a9598e4..ffb8fb00aa 100644
--- a/src/Juvix/Core/Type.hs
+++ b/src/Juvix/Core/Type.hs
@@ -1,3 +1,25 @@
 module Juvix.Core.Type where
 
-data CoreType
+import Juvix.Prelude
+import Juvix.Syntax.Abstract.Name
+
+data Type = Atomic Atom | Fun Type Type | Universe
+
+data Atom = Atom
+  { _atomHead :: Name,
+    _atomArgs :: [Type]
+  }
+
+makeLenses ''Atom
+
+-- destructs a type into the target and the arguments (left-to-right)
+destructType :: Type -> (Type, [Type])
+destructType ty = case ty of
+  Fun l r -> let (tgt, args) = destructType r in (tgt, l:args)
+  _ -> (ty, [])
+
+getTarget :: Type -> Type
+getTarget = fst . destructType
+
+getArgs :: Type -> [Type]
+getArgs = snd . destructType

From 9460d2147d97fe97c72e4404d7654843ea2140fa Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Tue, 26 Jul 2022 14:12:20 +0200
Subject: [PATCH 07/85] evaluator draft

---
 src/Juvix/Core/Builtins.hs  |  4 ++
 src/Juvix/Core/Context.hs   |  2 +
 src/Juvix/Core/Evaluator.hs | 85 +++++++++++++++++++++++++++++++++++++
 src/Juvix/Core/GNode.hs     | 52 +++++++++++++++++------
 src/Juvix/Core/Type.hs      | 12 +++---
 5 files changed, 137 insertions(+), 18 deletions(-)

diff --git a/src/Juvix/Core/Builtins.hs b/src/Juvix/Core/Builtins.hs
index 91b0139a7c..a099304358 100644
--- a/src/Juvix/Core/Builtins.hs
+++ b/src/Juvix/Core/Builtins.hs
@@ -1,5 +1,7 @@
 module Juvix.Core.Builtins where
 
+import Juvix.Prelude
+
 -- Builtin operations which the evaluator and the code generator treat
 -- specially.
 data BuiltinOp
@@ -18,6 +20,7 @@ data BuiltinOp
   | OpListTail
   | OpPairFst
   | OpPairSnd
+  deriving stock (Eq)
 
 -- Builtin data tags
 data BuiltinDataTag =
@@ -27,3 +30,4 @@ data BuiltinDataTag =
   | TagNil
   | TagCons
   | TagPair
+  deriving stock (Eq)
diff --git a/src/Juvix/Core/Context.hs b/src/Juvix/Core/Context.hs
index d318e15151..60cddbfaa3 100644
--- a/src/Juvix/Core/Context.hs
+++ b/src/Juvix/Core/Context.hs
@@ -24,6 +24,8 @@ data IdentInfo = IdentInfo
   { _identName :: Name,
     _identSymbol :: Symbol,
     _identType :: Type,
+    _identArgsNum :: Int,
+    -- _identArgsNum will be used often enough to justify avoiding recomputation
     _identArgsInfo :: [ArgumentInfo]
   }
 
diff --git a/src/Juvix/Core/Evaluator.hs b/src/Juvix/Core/Evaluator.hs
index 8eaba14387..025772288d 100644
--- a/src/Juvix/Core/Evaluator.hs
+++ b/src/Juvix/Core/Evaluator.hs
@@ -1,2 +1,87 @@
 module Juvix.Core.Evaluator where
 
+import Data.HashMap.Strict ((!))
+import Juvix.Core.Builtins
+import Juvix.Core.Context
+import Juvix.Core.GNode
+import Juvix.Prelude
+
+-- `eval ctx env n` evalues a node `n` whose all free variables point into
+-- `env`. All nodes in `ctx` and `env` are closed.
+eval :: forall i. Monoid i => IdentContext i -> [GNode i] -> GNode i -> GNode i
+eval !ctx = eval'
+  where
+    unimplemented :: a
+    unimplemented = error "not yet implemented"
+
+    evalError :: a
+    evalError = error "evaluation error"
+
+    mkBuiltinClosure :: [GNode i] -> BuiltinOp -> GNode i
+    mkBuiltinClosure = unimplemented
+
+    mkConstructorClosure :: [GNode i] -> Tag -> GNode i
+    mkConstructorClosure = unimplemented
+
+    eval' :: [GNode i] -> GNode i -> GNode i
+    eval' !env !n = case n of
+      Var _ idx -> env !! idx
+      Ident _ sym -> ctx ! sym
+      Builtin _ op -> mkBuiltinClosure env op
+      Constructor _ tag -> mkConstructorClosure env tag
+      ConstValue _ _ -> n
+      Hole _ -> n
+      Axiom _ -> n
+      App _ l r ->
+        -- The semantics for evaluating application (App l r) is:
+        --
+        -- eval env (App l r) =
+        --   case eval env l of
+        --     LambdaClosure env' b -> eval (eval env r : env') b
+        --
+        -- To do this more efficently for builtins, constructors and
+        -- multi-argument functions (without creating closures for each
+        -- intermediate function and matching each twice) we gather all
+        -- application arguments, evaluate them from left to right and
+        -- push the results onto the environment.
+        apply env l r []
+      Lambda i b -> LambdaClosure i env b
+      LetIn _ v b -> let !v' = eval' env v in eval' (v' : env) b
+      Case _ v bs ->
+        let !v' = eval' env v
+         in case v' of
+              Data _ tag args -> branch (args ++ env) tag bs
+              _ -> evalError
+      Data {} -> n
+      LambdaClosure {} -> n
+      Suspended {} -> n
+
+    apply :: [GNode i] -> GNode i -> GNode i -> [GNode i] -> GNode i
+    apply !env !n !a !args = case n of
+      App _ l r -> apply env l r (a : args)
+      _ -> push env env n a args
+
+    -- In `push env env' n args`, `a` is the first argument, `env` is the
+    -- environment of `a` and `args`, `env'` the environment of `n`.
+    push :: [GNode i] -> [GNode i] -> GNode i -> GNode i -> [GNode i] -> GNode i
+    push !env !env' !n !a !args = case n of
+      Lambda _ b -> push' env (eval' env a : env') b args
+      LambdaClosure _ env'' b -> push' env (eval' env a : env'') b args
+      Constructor {} -> unimplemented
+      Builtin {} -> unimplemented
+      ConstValue {} -> evalError
+      Data {} -> evalError
+      Hole {} -> Suspended mempty (mkApp' n (map (eval' env) args))
+      Axiom {} -> Suspended mempty (mkApp' n (map (eval' env) args))
+      _ -> push env env' (eval' env' n) a args
+
+    push' :: [GNode i] -> [GNode i] -> GNode i -> [GNode i] -> GNode i
+    push' !env !env' !n !args = case args of
+      a:args' -> push env env' n a args'
+      [] -> eval' env' n
+
+    branch :: [GNode i] -> Tag -> [CaseBranch i] -> GNode i
+    branch !env !tag = \case
+      (CaseBranch tag' b) : _ | tag' == tag -> eval' env b
+      _ : bs' -> branch env tag bs'
+      [] -> evalError
diff --git a/src/Juvix/Core/GNode.hs b/src/Juvix/Core/GNode.hs
index d00517589f..160ff203cb 100644
--- a/src/Juvix/Core/GNode.hs
+++ b/src/Juvix/Core/GNode.hs
@@ -21,6 +21,7 @@ type Symbol = Word
 -- "builtin" constructors, e.g., unit, nat, lists, pairs, so that the code
 -- generator can treat them specially.
 data Tag = BuiltinTag BuiltinDataTag | UserTag Word
+  deriving stock (Eq)
 
 -- de Bruijn index
 type Index = Int
@@ -39,6 +40,8 @@ data GNode i
     -- and the code generator. For example, basic arithmetic operations go into
     -- `Builtin`.
     Builtin !i !BuiltinOp
+  | -- A data constructor (the function that creates the data).
+    Constructor !i !Tag
   | ConstValue !i {-# UNPACK #-} !Constant
   | -- A hole. It's a unit for the purposes of evaluation.
     Hole !i
@@ -49,14 +52,17 @@ data GNode i
   | -- `let x := value in body` is not reducible to lambda + application for the purposes
     -- of ML-polymorphic / dependent type checking or code generation!
     LetIn !i !(GNode i) !(GNode i)
-  | -- Data constructor.
-    Data !i !Tag ![GNode i]
   | -- One-level case matching on the tag of a data constructor: `Case value
     -- branches`. `Case` is lazy: only the selected branch is evaluated. Lazy `if`
     -- can be implemented by a case on a boolean.
     Case !i !(GNode i) ![CaseBranch i]
-  | -- Execution only: `LambdaClosure env body`
+  | -- Evaluation only: evaluated data constructor (the actual data).
+    Data !i !Tag ![GNode i]
+  | -- Evaluation only: `LambdaClosure env body`
     LambdaClosure !i ![GNode i] !(GNode i)
+  | -- Evaluation only: a suspended term value which cannot be evaluated further,
+    -- e.g., a hole applied to some arguments.
+    Suspended !i !(GNode i)
 
 -- Other things we might need in the future:
 -- - laziness annotations (converting these to closures/thunks should be done
@@ -88,30 +94,34 @@ getInfo = \case
   Var i _ -> i
   Ident i _ -> i
   Builtin i _ -> i
+  Constructor i _ -> i
   ConstValue i _ -> i
   Hole i -> i
   Axiom i -> i
   App i _ _ -> i
   Lambda i _ -> i
   LetIn i _ _ -> i
-  Data i _ _ -> i
   Case i _ _ -> i
+  Data i _ _ -> i
   LambdaClosure i _ _ -> i
+  Suspended i _ -> i
 
 modifyInfoM :: Applicative m => (i -> m i) -> GNode i -> m (GNode i)
 modifyInfoM f = \case
   Var i idx -> Var <$> f i <*> pure idx
   Ident i sym -> Ident <$> f i <*> pure sym
   Builtin i op -> Builtin <$> f i <*> pure op
+  Constructor i tag -> Constructor <$> f i <*> pure tag
   ConstValue i v -> ConstValue <$> f i <*> pure v
   Hole i -> Hole <$> f i
   Axiom i -> Axiom <$> f i
   App i l r -> App <$> f i <*> pure l <*> pure r
   Lambda i b -> Lambda <$> f i <*> pure b
   LetIn i v b -> LetIn <$> f i <*> pure v <*> pure b
-  Data i tag args -> Data <$> f i <*> pure tag <*> pure args
   Case i v bs -> Case <$> f i <*> pure v <*> pure bs
+  Data i tag args -> Data <$> f i <*> pure tag <*> pure args
   LambdaClosure i env b -> LambdaClosure <$> f i <*> pure env <*> pure b
+  Suspended i t -> Suspended <$> f i <*> pure t
 
 modifyInfo :: (i -> i) -> GNode i -> GNode i
 modifyInfo f n = runIdentity $ modifyInfoM (pure . f) n
@@ -124,7 +134,24 @@ class GNodeFunctor i where
 class GNodeFoldable i where
   nfoldM :: (a -> a -> a) -> (GNode i -> m a) -> i -> m a
 
-class (GNodeFunctor i, GNodeFoldable i) => GNodeInfo i
+class (Monoid i, GNodeFunctor i, GNodeFoldable i) => GNodeInfo i
+
+{---------------------------------------------------------------------------------}
+{- simple helper functions -}
+
+mkApp :: GNode i -> [(i, GNode i)] -> GNode i
+mkApp = foldl' (\acc (i, n) -> App i acc n)
+
+mkApp' :: Monoid i => GNode i -> [GNode i] -> GNode i
+mkApp' = foldl' (App mempty)
+
+unfoldApp :: forall i. GNode i -> (GNode i, [(i, GNode i)])
+unfoldApp = go []
+  where
+    go :: [(i, GNode i)] -> GNode i -> (GNode i, [(i, GNode i)])
+    go acc n = case n of
+      App i l r -> go ((i, r) : acc) l
+      _ -> (n, acc)
 
 {---------------------------------------------------------------------------------}
 {- General recursors on GNode  -}
@@ -168,15 +195,14 @@ umapG coll f = go (coll ^. cEmpty)
         App i l r -> f c =<< (App i <$> go c' l <*> go c' r)
         Lambda i body -> f c . Lambda i =<< go c' body
         LetIn i value body -> f c =<< (LetIn i <$> go c' value <*> go c' body)
-        Data i tag args -> f c . Data i tag =<< mapM (go c') args
         Case i value bs -> f c =<< (Case i <$> go c' value <*> mapM (\(CaseBranch tag br) -> CaseBranch tag <$> go c' br) bs)
+        Data i tag args -> f c . Data i tag =<< mapM (go c') args
         LambdaClosure i env body -> f c =<< (LambdaClosure i <$> mapM (go c') env <*> go c' body)
+        Suspended i t -> f c . Suspended i =<< go c' t
         _ -> f c n'
       where
         c' = (coll ^. cCollect) n c
 
--- should there be n' here?
-
 umapM :: (Monad m, GNodeFunctor i) => (GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
 umapM f = umapG unitCollector (const f)
 
@@ -215,9 +241,10 @@ dmapG coll f = go (coll ^. cEmpty)
         App i l r -> App i <$> go c' l <*> go c' r
         Lambda i body -> Lambda i <$> go c' body
         LetIn i value body -> LetIn i <$> go c' value <*> go c' body
-        Data i tag args -> Data i tag <$> mapM (go c') args
         Case i value bs -> Case i <$> go c' value <*> mapM (\(CaseBranch tag br) -> CaseBranch tag <$> go c' br) bs
+        Data i tag args -> Data i tag <$> mapM (go c') args
         LambdaClosure i env body -> LambdaClosure i <$> mapM (go c') env <*> go c' body
+        Suspended i t -> Suspended i <$> go c' t
         _ -> return n'
 
 dmapM :: (Monad m, GNodeFunctor i) => (GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
@@ -255,9 +282,10 @@ ufoldG coll uplus f = go (coll ^. cEmpty)
       App _ l r -> uplus <$> ma <*> (uplus <$> go c' l <*> go c' r)
       Lambda _ body -> uplus <$> ma <*> go c' body
       LetIn _ value body -> uplus <$> ma <*> (uplus <$> go c' value <*> go c' body)
-      Data _ _ args -> foldr (liftM2 uplus . go c') ma args
       Case _ value bs -> uplus <$> ma <*> foldr (liftM2 uplus . (\(CaseBranch _ br) -> go c' br)) (go c' value) bs
+      Data _ _ args -> foldr (liftM2 uplus . go c') ma args
       LambdaClosure _ env body -> uplus <$> ma <*> foldr (liftM2 uplus . go c') (go c' body) env
+      Suspended _ t -> uplus <$> ma <*> go c' t
       _ -> ma
       where
         c' = (coll ^. cCollect) n c
@@ -350,7 +378,7 @@ subst t = umapN go
       Var _ idx | idx == k -> shift k t
       _ -> n
 
--- reduce all beta redexes present in a term and a the ones created upwards
+-- reduce all beta redexes present in a term and the ones created upwards
 -- (i.e., a "beta-development")
 reduceBeta :: forall i. GNodeInfo i => GNode i -> GNode i
 reduceBeta = umap go
diff --git a/src/Juvix/Core/Type.hs b/src/Juvix/Core/Type.hs
index ffb8fb00aa..8e0a099543 100644
--- a/src/Juvix/Core/Type.hs
+++ b/src/Juvix/Core/Type.hs
@@ -12,14 +12,14 @@ data Atom = Atom
 
 makeLenses ''Atom
 
--- destructs a type into the target and the arguments (left-to-right)
-destructType :: Type -> (Type, [Type])
-destructType ty = case ty of
-  Fun l r -> let (tgt, args) = destructType r in (tgt, l:args)
+-- unfold a type into the target and the arguments (left-to-right)
+unfoldType :: Type -> (Type, [Type])
+unfoldType ty = case ty of
+  Fun l r -> let (tgt, args) = unfoldType r in (tgt, l:args)
   _ -> (ty, [])
 
 getTarget :: Type -> Type
-getTarget = fst . destructType
+getTarget = fst . unfoldType
 
 getArgs :: Type -> [Type]
-getArgs = snd . destructType
+getArgs = snd . unfoldType

From 9054530cf595111a02e4dcddad8a54c6a05ce867 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Tue, 26 Jul 2022 17:06:35 +0200
Subject: [PATCH 08/85] info draft

---
 src/Juvix/Core/Context.hs          |   2 +-
 src/Juvix/Core/Evaluator.hs        |   6 +-
 src/Juvix/Core/FreeVariableInfo.hs |   9 +++
 src/Juvix/Core/GNode.hs            |  77 ++++++++++++----------
 src/Juvix/Core/Info.hs             | 100 +++++++++++++++++++++++++++++
 src/Juvix/Core/Language.hs         |  14 ++++
 src/Juvix/Core/Location.hs         |   9 +++
 src/Juvix/Core/Name.hs             |   6 ++
 8 files changed, 184 insertions(+), 39 deletions(-)
 create mode 100644 src/Juvix/Core/FreeVariableInfo.hs
 create mode 100644 src/Juvix/Core/Info.hs
 create mode 100644 src/Juvix/Core/Language.hs
 create mode 100644 src/Juvix/Core/Location.hs
 create mode 100644 src/Juvix/Core/Name.hs

diff --git a/src/Juvix/Core/Context.hs b/src/Juvix/Core/Context.hs
index 60cddbfaa3..8ff0ea4cbf 100644
--- a/src/Juvix/Core/Context.hs
+++ b/src/Juvix/Core/Context.hs
@@ -1,9 +1,9 @@
 module Juvix.Core.Context where
 
 import Juvix.Core.GNode
+import Juvix.Core.Name
 import Juvix.Core.Type
 import Juvix.Prelude
-import Juvix.Syntax.Abstract.Name
 
 type IdentContext i = HashMap Symbol (GNode i)
 
diff --git a/src/Juvix/Core/Evaluator.hs b/src/Juvix/Core/Evaluator.hs
index 025772288d..f034816877 100644
--- a/src/Juvix/Core/Evaluator.hs
+++ b/src/Juvix/Core/Evaluator.hs
@@ -8,7 +8,7 @@ import Juvix.Prelude
 
 -- `eval ctx env n` evalues a node `n` whose all free variables point into
 -- `env`. All nodes in `ctx` and `env` are closed.
-eval :: forall i. Monoid i => IdentContext i -> [GNode i] -> GNode i -> GNode i
+eval :: forall i. GNodeInfo i => IdentContext i -> [GNode i] -> GNode i -> GNode i
 eval !ctx = eval'
   where
     unimplemented :: a
@@ -71,8 +71,8 @@ eval !ctx = eval'
       Builtin {} -> unimplemented
       ConstValue {} -> evalError
       Data {} -> evalError
-      Hole {} -> Suspended mempty (mkApp' n (map (eval' env) args))
-      Axiom {} -> Suspended mempty (mkApp' n (map (eval' env) args))
+      Hole {} -> Suspended iempty (mkApp' n (map (eval' env) args))
+      Axiom {} -> Suspended iempty (mkApp' n (map (eval' env) args))
       _ -> push env env' (eval' env' n) a args
 
     push' :: [GNode i] -> [GNode i] -> GNode i -> [GNode i] -> GNode i
diff --git a/src/Juvix/Core/FreeVariableInfo.hs b/src/Juvix/Core/FreeVariableInfo.hs
new file mode 100644
index 0000000000..2f19cf5c55
--- /dev/null
+++ b/src/Juvix/Core/FreeVariableInfo.hs
@@ -0,0 +1,9 @@
+module Juvix.Core.FreeVariableInfo where
+
+import Juvix.Core.Language
+import Juvix.Prelude
+
+newtype FreeVariableInfo = FreeVariableInfo
+  { _freeVars :: HashSet Index
+  }
+
diff --git a/src/Juvix/Core/GNode.hs b/src/Juvix/Core/GNode.hs
index 160ff203cb..48cc071ecf 100644
--- a/src/Juvix/Core/GNode.hs
+++ b/src/Juvix/Core/GNode.hs
@@ -128,13 +128,19 @@ modifyInfo f n = runIdentity $ modifyInfoM (pure . f) n
 
 -- The info type should be functorial in GNode (especially with dependent types,
 -- we will want to store nodes inside the info annotations).
-class GNodeFunctor i where
-  nmapM :: (GNode i -> m (GNode i)) -> i -> m i
+class GNodeFunctor i j where
+  nmapM :: Monad m => (GNode j -> m (GNode j)) -> i -> m i
 
-class GNodeFoldable i where
-  nfoldM :: (a -> a -> a) -> (GNode i -> m a) -> i -> m a
+class GNodeFoldable i j where
+  nfoldM :: Monad m => (a -> a -> a) -> m a -> (GNode j -> m a) -> i -> m a
 
-class (Monoid i, GNodeFunctor i, GNodeFoldable i) => GNodeInfo i
+class GNodeEmpty i where
+  iempty :: i
+
+class (GNodeFunctor i i, GNodeFoldable i i, GNodeEmpty i) => GNodeInfo i
+
+class GNodeInfoFunctor i j i' where
+  nmapInfoM :: Monad m => (GNode j -> m i') -> i -> m i'
 
 {---------------------------------------------------------------------------------}
 {- simple helper functions -}
@@ -142,8 +148,8 @@ class (Monoid i, GNodeFunctor i, GNodeFoldable i) => GNodeInfo i
 mkApp :: GNode i -> [(i, GNode i)] -> GNode i
 mkApp = foldl' (\acc (i, n) -> App i acc n)
 
-mkApp' :: Monoid i => GNode i -> [GNode i] -> GNode i
-mkApp' = foldl' (App mempty)
+mkApp' :: GNodeInfo i => GNode i -> [GNode i] -> GNode i
+mkApp' = foldl' (App iempty)
 
 unfoldApp :: forall i. GNode i -> (GNode i, [(i, GNode i)])
 unfoldApp = go []
@@ -181,7 +187,7 @@ bindingCollector coll = Collector (coll ^. cEmpty) collect
 -- recursive subnodes have already been mapped
 umapG ::
   forall i c m.
-  (Monad m, GNodeFunctor i) =>
+  (Monad m, GNodeFunctor i i) =>
   Collector (GNode i) c ->
   (c -> GNode i -> m (GNode i)) ->
   GNode i ->
@@ -203,28 +209,28 @@ umapG coll f = go (coll ^. cEmpty)
       where
         c' = (coll ^. cCollect) n c
 
-umapM :: (Monad m, GNodeFunctor i) => (GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
+umapM :: (Monad m, GNodeFunctor i i) => (GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
 umapM f = umapG unitCollector (const f)
 
-umapMB :: (Monad m, GNodeFunctor i) => ([i] -> GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
+umapMB :: (Monad m, GNodeFunctor i i) => ([i] -> GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
 umapMB f = umapG (bindingCollector (Collector [] (:))) f
 
-umapMN :: (Monad m, GNodeFunctor i) => (Index -> GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
+umapMN :: (Monad m, GNodeFunctor i i) => (Index -> GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
 umapMN f = umapG (bindingCollector (Collector 0 (const (+ 1)))) f
 
-umap :: GNodeFunctor i => (GNode i -> GNode i) -> GNode i -> GNode i
+umap :: GNodeFunctor i i => (GNode i -> GNode i) -> GNode i -> GNode i
 umap f n = runIdentity $ umapM (return . f) n
 
-umapB :: GNodeFunctor i => ([i] -> GNode i -> GNode i) -> GNode i -> GNode i
+umapB :: GNodeFunctor i i => ([i] -> GNode i -> GNode i) -> GNode i -> GNode i
 umapB f n = runIdentity $ umapMB (\is -> return . f is) n
 
-umapN :: GNodeFunctor i => (Index -> GNode i -> GNode i) -> GNode i -> GNode i
+umapN :: GNodeFunctor i i => (Index -> GNode i -> GNode i) -> GNode i -> GNode i
 umapN f n = runIdentity $ umapMN (\idx -> return . f idx) n
 
 -- `dmapG` maps the nodes top-down
 dmapG ::
   forall i c m.
-  (Monad m, GNodeFunctor i) =>
+  (Monad m, GNodeFunctor i i) =>
   Collector (GNode i) c ->
   ( c ->
     GNode i ->
@@ -234,6 +240,7 @@ dmapG ::
   m (GNode i)
 dmapG coll f = go (coll ^. cEmpty)
   where
+    go :: c -> GNode i -> m (GNode i)
     go c n = do
       n' <- modifyInfoM (nmapM (go c)) =<< f c n
       let c' = (coll ^. cCollect) n' c
@@ -247,29 +254,29 @@ dmapG coll f = go (coll ^. cEmpty)
         Suspended i t -> Suspended i <$> go c' t
         _ -> return n'
 
-dmapM :: (Monad m, GNodeFunctor i) => (GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
+dmapM :: (Monad m, GNodeFunctor i i) => (GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
 dmapM f = dmapG unitCollector (const f)
 
-dmapMB :: (Monad m, GNodeFunctor i) => ([i] -> GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
+dmapMB :: (Monad m, GNodeFunctor i i) => ([i] -> GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
 dmapMB f = dmapG (bindingCollector (Collector [] (:))) f
 
-dmapMN :: (Monad m, GNodeFunctor i) => (Index -> GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
+dmapMN :: (Monad m, GNodeFunctor i i) => (Index -> GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
 dmapMN f = dmapG (bindingCollector (Collector 0 (const (+ 1)))) f
 
-dmap :: GNodeFunctor i => (GNode i -> GNode i) -> GNode i -> GNode i
+dmap :: GNodeFunctor i i => (GNode i -> GNode i) -> GNode i -> GNode i
 dmap f n = runIdentity $ dmapM (return . f) n
 
-dmapB :: GNodeFunctor i => ([i] -> GNode i -> GNode i) -> GNode i -> GNode i
+dmapB :: GNodeFunctor i i => ([i] -> GNode i -> GNode i) -> GNode i -> GNode i
 dmapB f n = runIdentity $ dmapMB (\is -> return . f is) n
 
-dmapN :: GNodeFunctor i => (Index -> GNode i -> GNode i) -> GNode i -> GNode i
+dmapN :: GNodeFunctor i i => (Index -> GNode i -> GNode i) -> GNode i -> GNode i
 dmapN f n = runIdentity $ dmapMN (\idx -> return . f idx) n
 
 -- `ufoldG` folds the tree bottom-up; `uplus` combines the values - it should be
 -- commutative and associative
 ufoldG ::
   forall i c a m.
-  (Monad m, GNodeFoldable i) =>
+  (Monad m, GNodeFoldable i i) =>
   Collector (GNode i) c ->
   (a -> a -> a) ->
   (c -> GNode i -> m a) ->
@@ -289,42 +296,42 @@ ufoldG coll uplus f = go (coll ^. cEmpty)
       _ -> ma
       where
         c' = (coll ^. cCollect) n c
-        ma = uplus <$> f c n <*> nfoldM uplus (go c) (getInfo n)
+        ma = nfoldM uplus (f c n) (go c) (getInfo n)
 
-ufoldM :: (Monad m, GNodeFoldable i) => (a -> a -> a) -> (GNode i -> m a) -> GNode i -> m a
+ufoldM :: (Monad m, GNodeFoldable i i) => (a -> a -> a) -> (GNode i -> m a) -> GNode i -> m a
 ufoldM uplus f = ufoldG unitCollector uplus (const f)
 
-ufoldMB :: (Monad m, GNodeFoldable i) => (a -> a -> a) -> ([i] -> GNode i -> m a) -> GNode i -> m a
+ufoldMB :: (Monad m, GNodeFoldable i i) => (a -> a -> a) -> ([i] -> GNode i -> m a) -> GNode i -> m a
 ufoldMB uplus f = ufoldG (bindingCollector (Collector [] (:))) uplus f
 
-ufoldMN :: (Monad m, GNodeFoldable i) => (a -> a -> a) -> (Index -> GNode i -> m a) -> GNode i -> m a
+ufoldMN :: (Monad m, GNodeFoldable i i) => (a -> a -> a) -> (Index -> GNode i -> m a) -> GNode i -> m a
 ufoldMN uplus f = ufoldG (bindingCollector (Collector 0 (const (+ 1)))) uplus f
 
-ufold :: GNodeFoldable i => (a -> a -> a) -> (GNode i -> a) -> GNode i -> a
+ufold :: GNodeFoldable i i => (a -> a -> a) -> (GNode i -> a) -> GNode i -> a
 ufold uplus f n = runIdentity $ ufoldM uplus (return . f) n
 
-ufoldB :: GNodeFoldable i => (a -> a -> a) -> ([i] -> GNode i -> a) -> GNode i -> a
+ufoldB :: GNodeFoldable i i => (a -> a -> a) -> ([i] -> GNode i -> a) -> GNode i -> a
 ufoldB uplus f n = runIdentity $ ufoldMB uplus (\is -> return . f is) n
 
-ufoldN :: GNodeFoldable i => (a -> a -> a) -> (Index -> GNode i -> a) -> GNode i -> a
+ufoldN :: GNodeFoldable i i => (a -> a -> a) -> (Index -> GNode i -> a) -> GNode i -> a
 ufoldN uplus f n = runIdentity $ ufoldMN uplus (\idx -> return . f idx) n
 
-walk :: (Monad m, GNodeFoldable i) => (GNode i -> m ()) -> GNode i -> m ()
+walk :: (Monad m, GNodeFoldable i i) => (GNode i -> m ()) -> GNode i -> m ()
 walk = ufoldM mappend
 
-walkB :: (Monad m, GNodeFoldable i) => ([i] -> GNode i -> m ()) -> GNode i -> m ()
+walkB :: (Monad m, GNodeFoldable i i) => ([i] -> GNode i -> m ()) -> GNode i -> m ()
 walkB = ufoldMB mappend
 
-walkN :: (Monad m, GNodeFoldable i) => (Index -> GNode i -> m ()) -> GNode i -> m ()
+walkN :: (Monad m, GNodeFoldable i i) => (Index -> GNode i -> m ()) -> GNode i -> m ()
 walkN = ufoldMN mappend
 
-gather :: GNodeFoldable i => (a -> GNode i -> a) -> a -> GNode i -> a
+gather :: GNodeFoldable i i => (a -> GNode i -> a) -> a -> GNode i -> a
 gather f acc n = fst $ run $ runState acc (walk (\n' -> modify (`f` n')) n)
 
-gatherB :: GNodeFoldable i => ([i] -> a -> GNode i -> a) -> a -> GNode i -> a
+gatherB :: GNodeFoldable i i => ([i] -> a -> GNode i -> a) -> a -> GNode i -> a
 gatherB f acc n = fst $ run $ runState acc (walkB (\is n' -> modify (\a -> f is a n')) n)
 
-gatherN :: GNodeFoldable i => (Index -> a -> GNode i -> a) -> a -> GNode i -> a
+gatherN :: GNodeFoldable i i => (Index -> a -> GNode i -> a) -> a -> GNode i -> a
 gatherN f acc n = fst $ run $ runState acc (walkN (\idx n' -> modify (\a -> f idx a n')) n)
 
 {---------------------------------------------------------------------------}
diff --git a/src/Juvix/Core/Info.hs b/src/Juvix/Core/Info.hs
new file mode 100644
index 0000000000..8154e770fa
--- /dev/null
+++ b/src/Juvix/Core/Info.hs
@@ -0,0 +1,100 @@
+{-# LANGUAGE UndecidableInstances #-}
+
+module Juvix.Core.Info where
+
+import Juvix.Core.GNode
+import Juvix.Core.Location
+import Juvix.Core.Name
+import Juvix.Core.Type
+import Juvix.Prelude
+
+data Info i = Info
+  { _infoName :: Maybe Name,
+    _infoType :: Maybe Type,
+    _infoLoc :: Maybe Location,
+    _infoBinding :: Maybe BindingInfo,
+    _infoMore :: i
+    -- much more will be added here by further phases of the pipeline (program
+    -- transformations on Core)
+  }
+
+data BindingInfo = BindingInfo
+  { _bindingName :: Name,
+    _bindingType :: Type
+  }
+
+makeLenses ''Info
+makeLenses ''BindingInfo
+
+type Node' i = GNode (Info i)
+
+data NoInfo = NoInfo
+
+type Node = Node' NoInfo
+
+instance GNodeFunctor i j => GNodeFunctor (Info i) j where
+  nmapM :: Monad m => (GNode j -> m (GNode j)) -> Info i -> m (Info i)
+  nmapM f i = do
+    i' <- nmapM f (i ^. infoMore)
+    return i {_infoMore = i'}
+
+instance GNodeFoldable i j => GNodeFoldable (Info i) j where
+  nfoldM :: Monad m => (a -> a -> a) -> m a -> (GNode j -> m a) -> Info i -> m a
+  nfoldM uplus a f i = nfoldM uplus a f (i ^. infoMore)
+
+instance GNodeEmpty i => GNodeEmpty (Info i) where
+  iempty :: Info i
+  iempty =
+    Info
+      { _infoName = Nothing,
+        _infoType = Nothing,
+        _infoLoc = Nothing,
+        _infoBinding = Nothing,
+        _infoMore = iempty
+      }
+
+instance
+  ( GNodeEmpty i,
+    GNodeFunctor i (Info i),
+    GNodeFoldable i (Info i)
+  ) =>
+  GNodeInfo (Info i)
+
+instance GNodeFunctor NoInfo j where
+  nmapM :: Monad m => (GNode j -> m (GNode j)) -> NoInfo -> m NoInfo
+  nmapM _ i = return i
+
+instance GNodeFoldable NoInfo j where
+  nfoldM :: (a -> a -> a) -> m a -> (GNode j -> m a) -> NoInfo -> m a
+  nfoldM _ a _ _ = a
+
+instance GNodeEmpty NoInfo where
+  iempty :: NoInfo
+  iempty = NoInfo
+
+testFun :: Node -> Node
+testFun = removeClosures
+
+hasNameInfo :: Info i -> Bool
+hasNameInfo i = isJust (i ^. infoName)
+
+getNameInfo :: Info i -> Name
+getNameInfo i = fromMaybe impossible (i ^. infoName)
+
+hasTypeInfo :: Info i -> Bool
+hasTypeInfo i = isJust (i ^. infoType)
+
+getTypeInfo :: Info i -> Type
+getTypeInfo i = fromMaybe impossible (i ^. infoType)
+
+hasLocInfo :: Info i -> Bool
+hasLocInfo i = isJust (i ^. infoLoc)
+
+getLocInfo :: Info i -> Location
+getLocInfo i = fromMaybe impossible (i ^. infoLoc)
+
+hasBindingInfo :: Info i -> Bool
+hasBindingInfo i = isJust (i ^. infoBinding)
+
+getBindingInfo :: Info i -> BindingInfo
+getBindingInfo i = fromMaybe impossible (i ^. infoBinding)
diff --git a/src/Juvix/Core/Language.hs b/src/Juvix/Core/Language.hs
new file mode 100644
index 0000000000..92cc830f2a
--- /dev/null
+++ b/src/Juvix/Core/Language.hs
@@ -0,0 +1,14 @@
+module Juvix.Core.Language
+  ( module Juvix.Core.Name,
+    module Juvix.Core.Location,
+    module Juvix.Core.Builtins,
+    module Juvix.Core.GNode,
+    module Juvix.Core.Info,
+  )
+where
+
+import Juvix.Core.Builtins
+import Juvix.Core.GNode
+import Juvix.Core.Info
+import Juvix.Core.Location
+import Juvix.Core.Name
diff --git a/src/Juvix/Core/Location.hs b/src/Juvix/Core/Location.hs
new file mode 100644
index 0000000000..7f30d206aa
--- /dev/null
+++ b/src/Juvix/Core/Location.hs
@@ -0,0 +1,9 @@
+module Juvix.Core.Location
+  ( module Juvix.Core.Location,
+    module Juvix.Prelude.Loc,
+  )
+where
+
+import Juvix.Prelude.Loc
+
+type Location = Interval
diff --git a/src/Juvix/Core/Name.hs b/src/Juvix/Core/Name.hs
new file mode 100644
index 0000000000..ecdc52a3e8
--- /dev/null
+++ b/src/Juvix/Core/Name.hs
@@ -0,0 +1,6 @@
+module Juvix.Core.Name
+  ( module Juvix.Syntax.Abstract.Name,
+  )
+where
+
+import Juvix.Syntax.Abstract.Name

From ee90563f87e1fdc7941a8f424f36d1c76355330f Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Wed, 27 Jul 2022 18:57:17 +0200
Subject: [PATCH 09/85] info based on Dynamic and TypeRep

---
 src/Juvix/Core/Builtins.hs              |   2 +-
 src/Juvix/Core/Context.hs               |  11 +-
 src/Juvix/Core/Evaluator.hs             |  28 +--
 src/Juvix/Core/FreeVariableInfo.hs      |   9 -
 src/Juvix/Core/Info.hs                  | 150 +++++-------
 src/Juvix/Core/Info/BindingInfo.hs      |  14 ++
 src/Juvix/Core/Info/FreeVariableInfo.hs |  26 ++
 src/Juvix/Core/Info/IdentInfo.hs        |  39 +++
 src/Juvix/Core/Info/LocationInfo.hs     |  10 +
 src/Juvix/Core/Info/NameInfo.hs         |  10 +
 src/Juvix/Core/Info/TypeInfo.hs         |  11 +
 src/Juvix/Core/Language.hs              |  14 --
 src/Juvix/Core/Location.hs              |   9 -
 src/Juvix/Core/Name.hs                  |   6 -
 src/Juvix/Core/{GNode.hs => Node.hs}    | 304 +++++++++++++-----------
 src/Juvix/Core/Prelude.hs               |  18 ++
 src/Juvix/Core/Type.hs                  |   3 +-
 17 files changed, 376 insertions(+), 288 deletions(-)
 delete mode 100644 src/Juvix/Core/FreeVariableInfo.hs
 create mode 100644 src/Juvix/Core/Info/BindingInfo.hs
 create mode 100644 src/Juvix/Core/Info/FreeVariableInfo.hs
 create mode 100644 src/Juvix/Core/Info/IdentInfo.hs
 create mode 100644 src/Juvix/Core/Info/LocationInfo.hs
 create mode 100644 src/Juvix/Core/Info/NameInfo.hs
 create mode 100644 src/Juvix/Core/Info/TypeInfo.hs
 delete mode 100644 src/Juvix/Core/Language.hs
 delete mode 100644 src/Juvix/Core/Location.hs
 delete mode 100644 src/Juvix/Core/Name.hs
 rename src/Juvix/Core/{GNode.hs => Node.hs} (55%)
 create mode 100644 src/Juvix/Core/Prelude.hs

diff --git a/src/Juvix/Core/Builtins.hs b/src/Juvix/Core/Builtins.hs
index a099304358..cfce346d79 100644
--- a/src/Juvix/Core/Builtins.hs
+++ b/src/Juvix/Core/Builtins.hs
@@ -3,7 +3,7 @@ module Juvix.Core.Builtins where
 import Juvix.Prelude
 
 -- Builtin operations which the evaluator and the code generator treat
--- specially.
+-- specially and non-uniformly.
 data BuiltinOp
   = OpIntAdd
   | OpIntSub
diff --git a/src/Juvix/Core/Context.hs b/src/Juvix/Core/Context.hs
index 8ff0ea4cbf..5a0868747f 100644
--- a/src/Juvix/Core/Context.hs
+++ b/src/Juvix/Core/Context.hs
@@ -1,14 +1,13 @@
 module Juvix.Core.Context where
 
-import Juvix.Core.GNode
-import Juvix.Core.Name
+import Juvix.Core.Node
+import Juvix.Core.Prelude
 import Juvix.Core.Type
-import Juvix.Prelude
 
-type IdentContext i = HashMap Symbol (GNode i)
+type IdentContext = HashMap Symbol Node
 
-data Context i = Context
-  { _identContext :: IdentContext i,
+data Context = Context
+  { _identContext :: IdentContext,
     _identInfo :: HashMap Symbol IdentInfo,
     -- We reuse `Name` for runtime-irrelevant identifiers (inductive type names,
     -- axiom names, etc). We shouldn't do this for Symbol and Tag, because we
diff --git a/src/Juvix/Core/Evaluator.hs b/src/Juvix/Core/Evaluator.hs
index f034816877..95294f2298 100644
--- a/src/Juvix/Core/Evaluator.hs
+++ b/src/Juvix/Core/Evaluator.hs
@@ -1,14 +1,14 @@
 module Juvix.Core.Evaluator where
 
 import Data.HashMap.Strict ((!))
-import Juvix.Core.Builtins
+import Juvix.Core.Info qualified as Info
 import Juvix.Core.Context
-import Juvix.Core.GNode
-import Juvix.Prelude
+import Juvix.Core.Node
+import Juvix.Core.Prelude
 
 -- `eval ctx env n` evalues a node `n` whose all free variables point into
 -- `env`. All nodes in `ctx` and `env` are closed.
-eval :: forall i. GNodeInfo i => IdentContext i -> [GNode i] -> GNode i -> GNode i
+eval :: IdentContext -> Env -> Node -> Node
 eval !ctx = eval'
   where
     unimplemented :: a
@@ -17,13 +17,13 @@ eval !ctx = eval'
     evalError :: a
     evalError = error "evaluation error"
 
-    mkBuiltinClosure :: [GNode i] -> BuiltinOp -> GNode i
+    mkBuiltinClosure :: Env -> BuiltinOp -> Node
     mkBuiltinClosure = unimplemented
 
-    mkConstructorClosure :: [GNode i] -> Tag -> GNode i
+    mkConstructorClosure :: Env -> Tag -> Node
     mkConstructorClosure = unimplemented
 
-    eval' :: [GNode i] -> GNode i -> GNode i
+    eval' :: Env -> Node -> Node
     eval' !env !n = case n of
       Var _ idx -> env !! idx
       Ident _ sym -> ctx ! sym
@@ -56,14 +56,14 @@ eval !ctx = eval'
       LambdaClosure {} -> n
       Suspended {} -> n
 
-    apply :: [GNode i] -> GNode i -> GNode i -> [GNode i] -> GNode i
+    apply :: Env -> Node -> Node -> [Node] -> Node
     apply !env !n !a !args = case n of
       App _ l r -> apply env l r (a : args)
       _ -> push env env n a args
 
     -- In `push env env' n args`, `a` is the first argument, `env` is the
     -- environment of `a` and `args`, `env'` the environment of `n`.
-    push :: [GNode i] -> [GNode i] -> GNode i -> GNode i -> [GNode i] -> GNode i
+    push :: Env -> Env -> Node -> Node -> [Node] -> Node
     push !env !env' !n !a !args = case n of
       Lambda _ b -> push' env (eval' env a : env') b args
       LambdaClosure _ env'' b -> push' env (eval' env a : env'') b args
@@ -71,16 +71,16 @@ eval !ctx = eval'
       Builtin {} -> unimplemented
       ConstValue {} -> evalError
       Data {} -> evalError
-      Hole {} -> Suspended iempty (mkApp' n (map (eval' env) args))
-      Axiom {} -> Suspended iempty (mkApp' n (map (eval' env) args))
+      Hole {} -> Suspended Info.empty (mkApp' n (map (eval' env) args))
+      Axiom {} -> Suspended Info.empty (mkApp' n (map (eval' env) args))
       _ -> push env env' (eval' env' n) a args
 
-    push' :: [GNode i] -> [GNode i] -> GNode i -> [GNode i] -> GNode i
+    push' :: Env -> Env -> Node -> [Node] -> Node
     push' !env !env' !n !args = case args of
-      a:args' -> push env env' n a args'
+      a : args' -> push env env' n a args'
       [] -> eval' env' n
 
-    branch :: [GNode i] -> Tag -> [CaseBranch i] -> GNode i
+    branch :: Env -> Tag -> [CaseBranch] -> Node
     branch !env !tag = \case
       (CaseBranch tag' b) : _ | tag' == tag -> eval' env b
       _ : bs' -> branch env tag bs'
diff --git a/src/Juvix/Core/FreeVariableInfo.hs b/src/Juvix/Core/FreeVariableInfo.hs
deleted file mode 100644
index 2f19cf5c55..0000000000
--- a/src/Juvix/Core/FreeVariableInfo.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module Juvix.Core.FreeVariableInfo where
-
-import Juvix.Core.Language
-import Juvix.Prelude
-
-newtype FreeVariableInfo = FreeVariableInfo
-  { _freeVars :: HashSet Index
-  }
-
diff --git a/src/Juvix/Core/Info.hs b/src/Juvix/Core/Info.hs
index 8154e770fa..1dc4095094 100644
--- a/src/Juvix/Core/Info.hs
+++ b/src/Juvix/Core/Info.hs
@@ -1,100 +1,68 @@
-{-# LANGUAGE UndecidableInstances #-}
-
 module Juvix.Core.Info where
 
-import Juvix.Core.GNode
-import Juvix.Core.Location
-import Juvix.Core.Name
-import Juvix.Core.Type
+import Data.Dynamic
+import Data.HashMap.Strict qualified as HashMap
 import Juvix.Prelude
 
-data Info i = Info
-  { _infoName :: Maybe Name,
-    _infoType :: Maybe Type,
-    _infoLoc :: Maybe Location,
-    _infoBinding :: Maybe BindingInfo,
-    _infoMore :: i
-    -- much more will be added here by further phases of the pipeline (program
-    -- transformations on Core)
+newtype Info = Info
+  { _infoMap :: HashMap TypeRep Dynamic
   }
 
-data BindingInfo = BindingInfo
-  { _bindingName :: Name,
-    _bindingType :: Type
-  }
+type Key = Proxy
 
 makeLenses ''Info
-makeLenses ''BindingInfo
-
-type Node' i = GNode (Info i)
-
-data NoInfo = NoInfo
-
-type Node = Node' NoInfo
-
-instance GNodeFunctor i j => GNodeFunctor (Info i) j where
-  nmapM :: Monad m => (GNode j -> m (GNode j)) -> Info i -> m (Info i)
-  nmapM f i = do
-    i' <- nmapM f (i ^. infoMore)
-    return i {_infoMore = i'}
-
-instance GNodeFoldable i j => GNodeFoldable (Info i) j where
-  nfoldM :: Monad m => (a -> a -> a) -> m a -> (GNode j -> m a) -> Info i -> m a
-  nfoldM uplus a f i = nfoldM uplus a f (i ^. infoMore)
-
-instance GNodeEmpty i => GNodeEmpty (Info i) where
-  iempty :: Info i
-  iempty =
-    Info
-      { _infoName = Nothing,
-        _infoType = Nothing,
-        _infoLoc = Nothing,
-        _infoBinding = Nothing,
-        _infoMore = iempty
-      }
-
-instance
-  ( GNodeEmpty i,
-    GNodeFunctor i (Info i),
-    GNodeFoldable i (Info i)
-  ) =>
-  GNodeInfo (Info i)
-
-instance GNodeFunctor NoInfo j where
-  nmapM :: Monad m => (GNode j -> m (GNode j)) -> NoInfo -> m NoInfo
-  nmapM _ i = return i
-
-instance GNodeFoldable NoInfo j where
-  nfoldM :: (a -> a -> a) -> m a -> (GNode j -> m a) -> NoInfo -> m a
-  nfoldM _ a _ _ = a
-
-instance GNodeEmpty NoInfo where
-  iempty :: NoInfo
-  iempty = NoInfo
-
-testFun :: Node -> Node
-testFun = removeClosures
-
-hasNameInfo :: Info i -> Bool
-hasNameInfo i = isJust (i ^. infoName)
-
-getNameInfo :: Info i -> Name
-getNameInfo i = fromMaybe impossible (i ^. infoName)
-
-hasTypeInfo :: Info i -> Bool
-hasTypeInfo i = isJust (i ^. infoType)
-
-getTypeInfo :: Info i -> Type
-getTypeInfo i = fromMaybe impossible (i ^. infoType)
-
-hasLocInfo :: Info i -> Bool
-hasLocInfo i = isJust (i ^. infoLoc)
-
-getLocInfo :: Info i -> Location
-getLocInfo i = fromMaybe impossible (i ^. infoLoc)
-
-hasBindingInfo :: Info i -> Bool
-hasBindingInfo i = isJust (i ^. infoBinding)
 
-getBindingInfo :: Info i -> BindingInfo
-getBindingInfo i = fromMaybe impossible (i ^. infoBinding)
+empty :: Info
+empty = Info HashMap.empty
+
+member :: Typeable a => Key a -> Info -> Bool
+member k i = HashMap.member (typeRep k) (i ^. infoMap)
+
+lookup :: Typeable a => Key a -> Info -> Maybe a
+lookup k i = case HashMap.lookup (typeRep k) (i ^. infoMap) of
+  Just a -> fromDyn a impossible
+  Nothing -> Nothing
+
+lookupDefault :: Typeable a => a -> Info -> a
+lookupDefault a i =
+  fromDyn (HashMap.lookupDefault (toDyn a) (typeOf a) (i ^. infoMap)) impossible
+
+(!) :: Typeable a => Key a -> Info -> a
+(!) k i = fromJust (Juvix.Core.Info.lookup k i)
+
+insert :: Typeable a => a -> Info -> Info
+insert a i = Info (HashMap.insert (typeOf a) (toDyn a) (i ^. infoMap))
+
+insertWith :: Typeable a => (a -> a -> a) -> a -> Info -> Info
+insertWith f a i = Info (HashMap.insertWith f' (typeOf a) (toDyn a) (i ^. infoMap))
+  where
+    f' x1 x2 = toDyn (f (fromDyn x1 impossible) (fromDyn x2 impossible))
+
+delete :: Typeable a => Key a -> Info -> Info
+delete k i = Info (HashMap.delete (typeRep k) (i ^. infoMap))
+
+adjust :: forall a. Typeable a => (a -> a) -> Info -> Info
+adjust f i =
+  Info $
+    HashMap.adjust
+      (\x -> toDyn $ f $ fromDyn x impossible)
+      (typeRep (Proxy :: Proxy a))
+      (i ^. infoMap)
+
+update :: forall a. Typeable a => (a -> Maybe a) -> Info -> Info
+update f i = Info (HashMap.update f' (typeRep (Proxy :: Proxy a)) (i ^. infoMap))
+  where
+    f' x = case f (fromDyn x impossible) of
+      Just y -> Just (toDyn y)
+      Nothing -> Nothing
+
+alter :: forall a. Typeable a => (Maybe a -> Maybe a) -> Info -> Info
+alter f i = Info (HashMap.alter f' (typeRep (Proxy :: Proxy a)) (i ^. infoMap))
+  where
+    f' x = case y of
+      Just y' -> Just (toDyn y')
+      Nothing -> Nothing
+      where
+        y = case x of
+          Just x' -> f (fromDyn x' impossible)
+          Nothing -> f Nothing
diff --git a/src/Juvix/Core/Info/BindingInfo.hs b/src/Juvix/Core/Info/BindingInfo.hs
new file mode 100644
index 0000000000..2499558961
--- /dev/null
+++ b/src/Juvix/Core/Info/BindingInfo.hs
@@ -0,0 +1,14 @@
+module Juvix.Core.Info.BindingInfo where
+
+import Juvix.Core.Prelude
+import Juvix.Core.Type
+
+data BindingInfo = BindingInfo
+  { _infoName :: Name,
+    _infoType :: Type
+  }
+
+kBindingInfo :: Key BindingInfo
+kBindingInfo = Proxy
+
+makeLenses ''BindingInfo
diff --git a/src/Juvix/Core/Info/FreeVariableInfo.hs b/src/Juvix/Core/Info/FreeVariableInfo.hs
new file mode 100644
index 0000000000..6ee04fcfc2
--- /dev/null
+++ b/src/Juvix/Core/Info/FreeVariableInfo.hs
@@ -0,0 +1,26 @@
+module Juvix.Core.Info.FreeVariableInfo where
+
+import Data.HashMap.Strict as HashMap
+import Juvix.Core.Info qualified as Info
+import Juvix.Core.Node
+import Juvix.Core.Prelude
+
+newtype FreeVariableInfo = FreeVariableInfo
+  { -- map free variables to the number of their occurrences
+    _infoFreeVars :: HashMap Index Int
+  }
+
+kFreeVariableInfo :: Key FreeVariableInfo
+kFreeVariableInfo = Proxy
+
+makeLenses ''FreeVariableInfo
+
+computeFreeVariableInfo :: Node -> Node
+computeFreeVariableInfo = umapN go
+  where
+    go :: Index -> Node -> Node
+    go k n = case n of
+      Var i idx | idx >= k -> Var (Info.insert fvi i) idx
+        where
+          fvi = FreeVariableInfo (HashMap.singleton (idx - k) 1)
+      _ -> undefined
diff --git a/src/Juvix/Core/Info/IdentInfo.hs b/src/Juvix/Core/Info/IdentInfo.hs
new file mode 100644
index 0000000000..0c3315937b
--- /dev/null
+++ b/src/Juvix/Core/Info/IdentInfo.hs
@@ -0,0 +1,39 @@
+module Juvix.Core.Info.IdentInfo where
+
+import Data.HashMap.Strict qualified as HashMap
+import Juvix.Core.Info qualified as Info
+import Juvix.Core.Node
+import Juvix.Core.Prelude
+
+newtype IdentInfo = IdentInfo
+  { -- map symbols to the number of their occurrences
+    _infoIdents :: HashMap Symbol Int
+  }
+
+kIdentInfo :: Key IdentInfo
+kIdentInfo = Proxy
+
+makeLenses ''IdentInfo
+
+computeIdentInfo :: Node -> Node
+computeIdentInfo = umap go
+  where
+    go :: Node -> Node
+    go n = case n of
+      Ident i sym -> Ident (Info.insert fvi i) sym
+        where
+          fvi = IdentInfo (HashMap.singleton sym 1)
+      _ -> modifyInfo (Info.insert fvi) n
+        where
+          fvi =
+            IdentInfo $
+              HashMap.unions
+                ( map
+                    ( \n' ->
+                        Info.lookupDefault
+                          (IdentInfo mempty)
+                          (getInfo n')
+                          ^. infoIdents
+                    )
+                    (children n)
+                )
diff --git a/src/Juvix/Core/Info/LocationInfo.hs b/src/Juvix/Core/Info/LocationInfo.hs
new file mode 100644
index 0000000000..3286d5918d
--- /dev/null
+++ b/src/Juvix/Core/Info/LocationInfo.hs
@@ -0,0 +1,10 @@
+module Juvix.Core.Info.LocationInfo where
+
+import Juvix.Core.Prelude
+
+newtype LocationInfo = LocationInfo { _infoLocation :: Location }
+
+kLocationInfo :: Key LocationInfo
+kLocationInfo = Proxy
+
+makeLenses ''LocationInfo
diff --git a/src/Juvix/Core/Info/NameInfo.hs b/src/Juvix/Core/Info/NameInfo.hs
new file mode 100644
index 0000000000..265b8eb281
--- /dev/null
+++ b/src/Juvix/Core/Info/NameInfo.hs
@@ -0,0 +1,10 @@
+module Juvix.Core.Info.NameInfo where
+
+import Juvix.Core.Prelude
+
+newtype NameInfo = NameInfo { _infoName :: Name }
+
+kNameInfo :: Key NameInfo
+kNameInfo = Proxy
+
+makeLenses ''NameInfo
diff --git a/src/Juvix/Core/Info/TypeInfo.hs b/src/Juvix/Core/Info/TypeInfo.hs
new file mode 100644
index 0000000000..76cb33907c
--- /dev/null
+++ b/src/Juvix/Core/Info/TypeInfo.hs
@@ -0,0 +1,11 @@
+module Juvix.Core.Info.TypeInfo where
+
+import Juvix.Core.Prelude
+import Juvix.Core.Type
+
+newtype TypeInfo = TypeInfo { _infoType :: Type }
+
+kTypeInfo :: Key TypeInfo
+kTypeInfo = Proxy
+
+makeLenses ''TypeInfo
diff --git a/src/Juvix/Core/Language.hs b/src/Juvix/Core/Language.hs
deleted file mode 100644
index 92cc830f2a..0000000000
--- a/src/Juvix/Core/Language.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-module Juvix.Core.Language
-  ( module Juvix.Core.Name,
-    module Juvix.Core.Location,
-    module Juvix.Core.Builtins,
-    module Juvix.Core.GNode,
-    module Juvix.Core.Info,
-  )
-where
-
-import Juvix.Core.Builtins
-import Juvix.Core.GNode
-import Juvix.Core.Info
-import Juvix.Core.Location
-import Juvix.Core.Name
diff --git a/src/Juvix/Core/Location.hs b/src/Juvix/Core/Location.hs
deleted file mode 100644
index 7f30d206aa..0000000000
--- a/src/Juvix/Core/Location.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module Juvix.Core.Location
-  ( module Juvix.Core.Location,
-    module Juvix.Prelude.Loc,
-  )
-where
-
-import Juvix.Prelude.Loc
-
-type Location = Interval
diff --git a/src/Juvix/Core/Name.hs b/src/Juvix/Core/Name.hs
deleted file mode 100644
index ecdc52a3e8..0000000000
--- a/src/Juvix/Core/Name.hs
+++ /dev/null
@@ -1,6 +0,0 @@
-module Juvix.Core.Name
-  ( module Juvix.Syntax.Abstract.Name,
-  )
-where
-
-import Juvix.Syntax.Abstract.Name
diff --git a/src/Juvix/Core/GNode.hs b/src/Juvix/Core/Node.hs
similarity index 55%
rename from src/Juvix/Core/GNode.hs
rename to src/Juvix/Core/Node.hs
index 48cc071ecf..4fd2471d0f 100644
--- a/src/Juvix/Core/GNode.hs
+++ b/src/Juvix/Core/Node.hs
@@ -1,14 +1,15 @@
-module Juvix.Core.GNode where
+module Juvix.Core.Node where
 
 {-
-  This file defines the graph representation of JuvixCore (GNode datatype) and
+  This file defines the graph representation of JuvixCore (Node datatype) and
   general recursors on it.
 -}
 
 import Data.Functor.Identity
 import Data.HashSet qualified as HashSet
-import Juvix.Core.Builtins
-import Juvix.Prelude
+import Juvix.Core.Info qualified as Info
+import Juvix.Core.Info.BindingInfo
+import Juvix.Core.Prelude
 
 {---------------------------------------------------------------------------------}
 {- Program graph datatype -}
@@ -26,43 +27,43 @@ data Tag = BuiltinTag BuiltinDataTag | UserTag Word
 -- de Bruijn index
 type Index = Int
 
--- `GNode i` is the type of nodes in the program graph, where `i` is the info
--- type. `GNode` itself contains only runtime-relevant information.
--- Runtime-irrelevant annotations (including all type information) are stored in
--- the `i` argument of the `NodeInfo` nodes.
-data GNode i
+-- `Node` is the type of nodes in the program graph. The nodes themselves
+-- contain only runtime-relevant information. Runtime-irrelevant annotations
+-- (including all type information) are stored in the infos associated with each
+-- each.
+data Node
   = -- De Bruijn index of a locally lambda-bound variable.
-    Var !i !Index
+    Var !Info !Index
   | -- Global identifier of a function (with corresponding `GNode` in the global
     -- context).
-    Ident !i !Symbol
+    Ident !Info !Symbol
   | -- A builtin with no corresponding GNode, treated specially by the evaluator
     -- and the code generator. For example, basic arithmetic operations go into
     -- `Builtin`.
-    Builtin !i !BuiltinOp
+    Builtin !Info !BuiltinOp
   | -- A data constructor (the function that creates the data).
-    Constructor !i !Tag
-  | ConstValue !i {-# UNPACK #-} !Constant
+    Constructor !Info !Tag
+  | ConstValue !Info {-# UNPACK #-} !Constant
   | -- A hole. It's a unit for the purposes of evaluation.
-    Hole !i
+    Hole !Info
   | -- An axiom. Computationally a unit.
-    Axiom !i
-  | App !i !(GNode i) !(GNode i)
-  | Lambda !i !(GNode i)
+    Axiom !Info
+  | App !Info !Node !Node
+  | Lambda !Info !Node
   | -- `let x := value in body` is not reducible to lambda + application for the purposes
     -- of ML-polymorphic / dependent type checking or code generation!
-    LetIn !i !(GNode i) !(GNode i)
+    LetIn !Info !Node !Node
   | -- One-level case matching on the tag of a data constructor: `Case value
     -- branches`. `Case` is lazy: only the selected branch is evaluated. Lazy `if`
     -- can be implemented by a case on a boolean.
-    Case !i !(GNode i) ![CaseBranch i]
+    Case !Info !Node ![CaseBranch]
   | -- Evaluation only: evaluated data constructor (the actual data).
-    Data !i !Tag ![GNode i]
+    Data !Info !Tag ![Node]
   | -- Evaluation only: `LambdaClosure env body`
-    LambdaClosure !i ![GNode i] !(GNode i)
+    LambdaClosure !Info !Env !Node
   | -- Evaluation only: a suspended term value which cannot be evaluated further,
     -- e.g., a hole applied to some arguments.
-    Suspended !i !(GNode i)
+    Suspended !Info !Node
 
 -- Other things we might need in the future:
 -- - laziness annotations (converting these to closures/thunks should be done
@@ -84,12 +85,16 @@ data Constant
 -- - ConstFloat
 -- - ConstString
 
-data CaseBranch i = CaseBranch !Tag !(GNode i)
+data CaseBranch = CaseBranch !Tag !Node
+
+-- all nodes in an environment must be closed (no free variables, i.e., de
+-- Bruijn indices pointing outside the term)
+type Env = [Node]
 
 {---------------------------------------------------------------------------------}
 {- Info -}
 
-getInfo :: GNode i -> i
+getInfo :: Node -> Info
 getInfo = \case
   Var i _ -> i
   Ident i _ -> i
@@ -106,7 +111,7 @@ getInfo = \case
   LambdaClosure i _ _ -> i
   Suspended i _ -> i
 
-modifyInfoM :: Applicative m => (i -> m i) -> GNode i -> m (GNode i)
+modifyInfoM :: Applicative m => (Info -> m Info) -> Node -> m Node
 modifyInfoM f = \case
   Var i idx -> Var <$> f i <*> pure idx
   Ident i sym -> Ident <$> f i <*> pure sym
@@ -123,44 +128,63 @@ modifyInfoM f = \case
   LambdaClosure i env b -> LambdaClosure <$> f i <*> pure env <*> pure b
   Suspended i t -> Suspended <$> f i <*> pure t
 
-modifyInfo :: (i -> i) -> GNode i -> GNode i
+modifyInfo :: (Info -> Info) -> Node -> Node
 modifyInfo f n = runIdentity $ modifyInfoM (pure . f) n
 
--- The info type should be functorial in GNode (especially with dependent types,
--- we will want to store nodes inside the info annotations).
-class GNodeFunctor i j where
-  nmapM :: Monad m => (GNode j -> m (GNode j)) -> i -> m i
-
-class GNodeFoldable i j where
-  nfoldM :: Monad m => (a -> a -> a) -> m a -> (GNode j -> m a) -> i -> m a
-
-class GNodeEmpty i where
-  iempty :: i
-
-class (GNodeFunctor i i, GNodeFoldable i i, GNodeEmpty i) => GNodeInfo i
-
-class GNodeInfoFunctor i j i' where
-  nmapInfoM :: Monad m => (GNode j -> m i') -> i -> m i'
-
 {---------------------------------------------------------------------------------}
 {- simple helper functions -}
 
-mkApp :: GNode i -> [(i, GNode i)] -> GNode i
+mkApp :: Node -> [(Info, Node)] -> Node
 mkApp = foldl' (\acc (i, n) -> App i acc n)
 
-mkApp' :: GNodeInfo i => GNode i -> [GNode i] -> GNode i
-mkApp' = foldl' (App iempty)
+mkApp' :: Node -> [Node] -> Node
+mkApp' = foldl' (App Info.empty)
 
-unfoldApp :: forall i. GNode i -> (GNode i, [(i, GNode i)])
+unfoldApp :: Node -> (Node, [(Info, Node)])
 unfoldApp = go []
   where
-    go :: [(i, GNode i)] -> GNode i -> (GNode i, [(i, GNode i)])
+    go :: [(Info, Node)] -> Node -> (Node, [(Info, Node)])
     go acc n = case n of
       App i l r -> go ((i, r) : acc) l
       _ -> (n, acc)
 
+children :: Node -> [Node]
+children = \case
+  App _ l r -> [l, r]
+  Lambda _ b -> [b]
+  LetIn _ v b -> [v, b]
+  Case _ v bs -> v : map (\(CaseBranch _ br) -> br) bs
+  Data _ _ args -> args
+  LambdaClosure _ env b -> b : env
+  Suspended _ t -> [t]
+  _ -> []
+
+-- children not under binder
+schildren :: Node -> [Node]
+schildren = \case
+  App _ l r -> [l, r]
+  LetIn _ v _ -> [v]
+  Case _ v bs -> v : map (\(CaseBranch _ br) -> br) bs
+  Data _ _ args -> args
+  LambdaClosure _ env _ -> env
+  Suspended _ t -> [t]
+  _ -> []
+
+-- children under binder
+bchildren :: Node -> [Node]
+bchildren = \case
+  Lambda _ b -> [b]
+  LetIn _ _ b -> [b]
+  LambdaClosure _ _ b -> [b]
+  _ -> []
+
 {---------------------------------------------------------------------------------}
-{- General recursors on GNode  -}
+{- General recursors on Node  -}
+
+-- Note: In the (distant) future, with dependent types, the type information
+-- will contain Nodes. Then mapping/folding needs to be performed also on the
+-- Nodes stored as type information. This will require modifying type
+-- information in the recursors below.
 
 -- a collector collects information top-down on a single path in the program
 -- tree
@@ -174,7 +198,7 @@ makeLenses ''Collector
 unitCollector :: Collector a ()
 unitCollector = Collector () (\_ _ -> ())
 
-bindingCollector :: Collector i c -> Collector (GNode i) c
+bindingCollector :: Collector Info c -> Collector Node c
 bindingCollector coll = Collector (coll ^. cEmpty) collect
   where
     collect n c = case n of
@@ -183,66 +207,75 @@ bindingCollector coll = Collector (coll ^. cEmpty) collect
       LambdaClosure i _ _ -> (coll ^. cCollect) i c
       _ -> c
 
+bindingInfoCollector :: Collector Node [Maybe BindingInfo]
+bindingInfoCollector =
+  bindingCollector
+    ( Collector
+        []
+        (\i c -> Info.lookup kBindingInfo i : c)
+    )
+
+bindingNumCollector :: Collector Node Index
+bindingNumCollector = bindingCollector (Collector 0 (const (+ 1)))
+
 -- `umapG` maps the nodes bottom-up, i.e., when invoking the mapper function the
 -- recursive subnodes have already been mapped
 umapG ::
-  forall i c m.
-  (Monad m, GNodeFunctor i i) =>
-  Collector (GNode i) c ->
-  (c -> GNode i -> m (GNode i)) ->
-  GNode i ->
-  m (GNode i)
+  forall c m.
+  Monad m =>
+  Collector Node c ->
+  (c -> Node -> m Node) ->
+  Node ->
+  m Node
 umapG coll f = go (coll ^. cEmpty)
   where
-    go :: c -> GNode i -> m (GNode i)
-    go c n = do
-      n' <- modifyInfoM (nmapM (go c)) n
-      case n' of
-        App i l r -> f c =<< (App i <$> go c' l <*> go c' r)
-        Lambda i body -> f c . Lambda i =<< go c' body
-        LetIn i value body -> f c =<< (LetIn i <$> go c' value <*> go c' body)
-        Case i value bs -> f c =<< (Case i <$> go c' value <*> mapM (\(CaseBranch tag br) -> CaseBranch tag <$> go c' br) bs)
-        Data i tag args -> f c . Data i tag =<< mapM (go c') args
-        LambdaClosure i env body -> f c =<< (LambdaClosure i <$> mapM (go c') env <*> go c' body)
-        Suspended i t -> f c . Suspended i =<< go c' t
-        _ -> f c n'
+    go :: c -> Node -> m Node
+    go c n = case n of
+      App i l r -> f c =<< (App i <$> go c' l <*> go c' r)
+      Lambda i body -> f c . Lambda i =<< go c' body
+      LetIn i value body -> f c =<< (LetIn i <$> go c' value <*> go c' body)
+      Case i value bs -> f c =<< (Case i <$> go c' value <*> mapM (\(CaseBranch tag br) -> CaseBranch tag <$> go c' br) bs)
+      Data i tag args -> f c . Data i tag =<< mapM (go c') args
+      LambdaClosure i env body -> f c =<< (LambdaClosure i <$> mapM (go c') env <*> go c' body)
+      Suspended i t -> f c . Suspended i =<< go c' t
+      _ -> f c n
       where
         c' = (coll ^. cCollect) n c
 
-umapM :: (Monad m, GNodeFunctor i i) => (GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
+umapM :: Monad m => (Node -> m Node) -> Node -> m Node
 umapM f = umapG unitCollector (const f)
 
-umapMB :: (Monad m, GNodeFunctor i i) => ([i] -> GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
-umapMB f = umapG (bindingCollector (Collector [] (:))) f
+umapMB :: Monad m => ([Maybe BindingInfo] -> Node -> m Node) -> Node -> m Node
+umapMB f = umapG bindingInfoCollector f
 
-umapMN :: (Monad m, GNodeFunctor i i) => (Index -> GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
-umapMN f = umapG (bindingCollector (Collector 0 (const (+ 1)))) f
+umapMN :: Monad m => (Index -> Node -> m Node) -> Node -> m Node
+umapMN f = umapG bindingNumCollector f
 
-umap :: GNodeFunctor i i => (GNode i -> GNode i) -> GNode i -> GNode i
+umap :: (Node -> Node) -> Node -> Node
 umap f n = runIdentity $ umapM (return . f) n
 
-umapB :: GNodeFunctor i i => ([i] -> GNode i -> GNode i) -> GNode i -> GNode i
+umapB :: ([Maybe BindingInfo] -> Node -> Node) -> Node -> Node
 umapB f n = runIdentity $ umapMB (\is -> return . f is) n
 
-umapN :: GNodeFunctor i i => (Index -> GNode i -> GNode i) -> GNode i -> GNode i
+umapN :: (Index -> Node -> Node) -> Node -> Node
 umapN f n = runIdentity $ umapMN (\idx -> return . f idx) n
 
 -- `dmapG` maps the nodes top-down
 dmapG ::
-  forall i c m.
-  (Monad m, GNodeFunctor i i) =>
-  Collector (GNode i) c ->
+  forall c m.
+  Monad m =>
+  Collector Node c ->
   ( c ->
-    GNode i ->
-    m (GNode i)
+    Node ->
+    m Node
   ) ->
-  GNode i ->
-  m (GNode i)
+  Node ->
+  m Node
 dmapG coll f = go (coll ^. cEmpty)
   where
-    go :: c -> GNode i -> m (GNode i)
+    go :: c -> Node -> m Node
     go c n = do
-      n' <- modifyInfoM (nmapM (go c)) =<< f c n
+      n' <- f c n
       let c' = (coll ^. cCollect) n' c
       case n' of
         App i l r -> App i <$> go c' l <*> go c' r
@@ -254,114 +287,113 @@ dmapG coll f = go (coll ^. cEmpty)
         Suspended i t -> Suspended i <$> go c' t
         _ -> return n'
 
-dmapM :: (Monad m, GNodeFunctor i i) => (GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
+dmapM :: Monad m => (Node -> m Node) -> Node -> m Node
 dmapM f = dmapG unitCollector (const f)
 
-dmapMB :: (Monad m, GNodeFunctor i i) => ([i] -> GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
-dmapMB f = dmapG (bindingCollector (Collector [] (:))) f
+dmapMB :: Monad m => ([Maybe BindingInfo] -> Node -> m Node) -> Node -> m Node
+dmapMB f = dmapG bindingInfoCollector f
 
-dmapMN :: (Monad m, GNodeFunctor i i) => (Index -> GNode i -> m (GNode i)) -> GNode i -> m (GNode i)
-dmapMN f = dmapG (bindingCollector (Collector 0 (const (+ 1)))) f
+dmapMN :: Monad m => (Index -> Node -> m Node) -> Node -> m Node
+dmapMN f = dmapG bindingNumCollector f
 
-dmap :: GNodeFunctor i i => (GNode i -> GNode i) -> GNode i -> GNode i
+dmap :: (Node -> Node) -> Node -> Node
 dmap f n = runIdentity $ dmapM (return . f) n
 
-dmapB :: GNodeFunctor i i => ([i] -> GNode i -> GNode i) -> GNode i -> GNode i
+dmapB :: ([Maybe BindingInfo] -> Node -> Node) -> Node -> Node
 dmapB f n = runIdentity $ dmapMB (\is -> return . f is) n
 
-dmapN :: GNodeFunctor i i => (Index -> GNode i -> GNode i) -> GNode i -> GNode i
+dmapN :: (Index -> Node -> Node) -> Node -> Node
 dmapN f n = runIdentity $ dmapMN (\idx -> return . f idx) n
 
 -- `ufoldG` folds the tree bottom-up; `uplus` combines the values - it should be
 -- commutative and associative
 ufoldG ::
-  forall i c a m.
-  (Monad m, GNodeFoldable i i) =>
-  Collector (GNode i) c ->
+  forall c a m.
+  Monad m =>
+  Collector Node c ->
   (a -> a -> a) ->
-  (c -> GNode i -> m a) ->
-  GNode i ->
+  (c -> Node -> m a) ->
+  Node ->
   m a
 ufoldG coll uplus f = go (coll ^. cEmpty)
   where
-    go :: c -> GNode i -> m a
+    go :: c -> Node -> m a
     go c n = case n of
-      App _ l r -> uplus <$> ma <*> (uplus <$> go c' l <*> go c' r)
-      Lambda _ body -> uplus <$> ma <*> go c' body
-      LetIn _ value body -> uplus <$> ma <*> (uplus <$> go c' value <*> go c' body)
-      Case _ value bs -> uplus <$> ma <*> foldr (liftM2 uplus . (\(CaseBranch _ br) -> go c' br)) (go c' value) bs
-      Data _ _ args -> foldr (liftM2 uplus . go c') ma args
-      LambdaClosure _ env body -> uplus <$> ma <*> foldr (liftM2 uplus . go c') (go c' body) env
-      Suspended _ t -> uplus <$> ma <*> go c' t
-      _ -> ma
+      App _ l r -> uplus <$> f c n <*> (uplus <$> go c' l <*> go c' r)
+      Lambda _ body -> uplus <$> f c n <*> go c' body
+      LetIn _ value body -> uplus <$> f c n <*> (uplus <$> go c' value <*> go c' body)
+      Case _ value bs -> uplus <$> f c n <*> foldr (liftM2 uplus . (\(CaseBranch _ br) -> go c' br)) (go c' value) bs
+      Data _ _ args -> foldr (liftM2 uplus . go c') (f c n) args
+      LambdaClosure _ env body -> uplus <$> f c n <*> foldr (liftM2 uplus . go c') (go c' body) env
+      Suspended _ t -> uplus <$> f c n <*> go c' t
+      _ -> f c n
       where
         c' = (coll ^. cCollect) n c
-        ma = nfoldM uplus (f c n) (go c) (getInfo n)
 
-ufoldM :: (Monad m, GNodeFoldable i i) => (a -> a -> a) -> (GNode i -> m a) -> GNode i -> m a
+ufoldM :: Monad m => (a -> a -> a) -> (Node -> m a) -> Node -> m a
 ufoldM uplus f = ufoldG unitCollector uplus (const f)
 
-ufoldMB :: (Monad m, GNodeFoldable i i) => (a -> a -> a) -> ([i] -> GNode i -> m a) -> GNode i -> m a
-ufoldMB uplus f = ufoldG (bindingCollector (Collector [] (:))) uplus f
+ufoldMB :: Monad m => (a -> a -> a) -> ([Maybe BindingInfo] -> Node -> m a) -> Node -> m a
+ufoldMB uplus f = ufoldG bindingInfoCollector uplus f
 
-ufoldMN :: (Monad m, GNodeFoldable i i) => (a -> a -> a) -> (Index -> GNode i -> m a) -> GNode i -> m a
-ufoldMN uplus f = ufoldG (bindingCollector (Collector 0 (const (+ 1)))) uplus f
+ufoldMN :: Monad m => (a -> a -> a) -> (Index -> Node -> m a) -> Node -> m a
+ufoldMN uplus f = ufoldG bindingNumCollector uplus f
 
-ufold :: GNodeFoldable i i => (a -> a -> a) -> (GNode i -> a) -> GNode i -> a
+ufold :: (a -> a -> a) -> (Node -> a) -> Node -> a
 ufold uplus f n = runIdentity $ ufoldM uplus (return . f) n
 
-ufoldB :: GNodeFoldable i i => (a -> a -> a) -> ([i] -> GNode i -> a) -> GNode i -> a
+ufoldB :: (a -> a -> a) -> ([Maybe BindingInfo] -> Node -> a) -> Node -> a
 ufoldB uplus f n = runIdentity $ ufoldMB uplus (\is -> return . f is) n
 
-ufoldN :: GNodeFoldable i i => (a -> a -> a) -> (Index -> GNode i -> a) -> GNode i -> a
+ufoldN :: (a -> a -> a) -> (Index -> Node -> a) -> Node -> a
 ufoldN uplus f n = runIdentity $ ufoldMN uplus (\idx -> return . f idx) n
 
-walk :: (Monad m, GNodeFoldable i i) => (GNode i -> m ()) -> GNode i -> m ()
+walk :: Monad m => (Node -> m ()) -> Node -> m ()
 walk = ufoldM mappend
 
-walkB :: (Monad m, GNodeFoldable i i) => ([i] -> GNode i -> m ()) -> GNode i -> m ()
+walkB :: Monad m => ([Maybe BindingInfo] -> Node -> m ()) -> Node -> m ()
 walkB = ufoldMB mappend
 
-walkN :: (Monad m, GNodeFoldable i i) => (Index -> GNode i -> m ()) -> GNode i -> m ()
+walkN :: Monad m => (Index -> Node -> m ()) -> Node -> m ()
 walkN = ufoldMN mappend
 
-gather :: GNodeFoldable i i => (a -> GNode i -> a) -> a -> GNode i -> a
+gather :: (a -> Node -> a) -> a -> Node -> a
 gather f acc n = fst $ run $ runState acc (walk (\n' -> modify (`f` n')) n)
 
-gatherB :: GNodeFoldable i i => ([i] -> a -> GNode i -> a) -> a -> GNode i -> a
+gatherB :: ([Maybe BindingInfo] -> a -> Node -> a) -> a -> Node -> a
 gatherB f acc n = fst $ run $ runState acc (walkB (\is n' -> modify (\a -> f is a n')) n)
 
-gatherN :: GNodeFoldable i i => (Index -> a -> GNode i -> a) -> a -> GNode i -> a
+gatherN :: (Index -> a -> Node -> a) -> a -> Node -> a
 gatherN f acc n = fst $ run $ runState acc (walkN (\idx n' -> modify (\a -> f idx a n')) n)
 
 {---------------------------------------------------------------------------}
 {- useful functions implemented using general recursors -}
 
-isClosed :: GNodeInfo i => GNode i -> Bool
+isClosed :: Node -> Bool
 isClosed = ufoldN (&&) go
   where
-    go :: Index -> GNode i -> Bool
+    go :: Index -> Node -> Bool
     go k = \case
       Var _ idx | idx >= k -> False
       _ -> True
 
-getFreeVars :: GNodeInfo i => GNode i -> HashSet Index
+getFreeVars :: Node -> HashSet Index
 getFreeVars = gatherN go HashSet.empty
   where
-    go :: Index -> HashSet Index -> GNode i -> HashSet Index
+    go :: Index -> HashSet Index -> Node -> HashSet Index
     go k acc = \case
       Var _ idx | idx >= k -> HashSet.insert (idx - k) acc
       _ -> acc
 
-getIdents :: GNodeInfo i => GNode i -> HashSet Symbol
+getIdents :: Node -> HashSet Symbol
 getIdents = gather go HashSet.empty
   where
-    go :: HashSet Symbol -> GNode i -> HashSet Symbol
+    go :: HashSet Symbol -> Node -> HashSet Symbol
     go acc = \case
       Ident _ sym -> HashSet.insert sym acc
       _ -> acc
 
-countFreeVarOccurrences :: GNodeInfo i => Index -> GNode i -> Int
+countFreeVarOccurrences :: Index -> Node -> Int
 countFreeVarOccurrences idx = gatherN go 0
   where
     go k acc = \case
@@ -369,7 +401,7 @@ countFreeVarOccurrences idx = gatherN go 0
       _ -> acc
 
 -- increase all free variable indices by a given value
-shift :: GNodeInfo i => Index -> GNode i -> GNode i
+shift :: Index -> Node -> Node
 shift m = umapN go
   where
     go k n = case n of
@@ -378,7 +410,7 @@ shift m = umapN go
 
 -- substitute a term t for the free variable with de Bruijn index 0, avoiding
 -- variable capture
-subst :: GNodeInfo i => GNode i -> GNode i -> GNode i
+subst :: Node -> Node -> Node
 subst t = umapN go
   where
     go k n = case n of
@@ -387,26 +419,26 @@ subst t = umapN go
 
 -- reduce all beta redexes present in a term and the ones created upwards
 -- (i.e., a "beta-development")
-reduceBeta :: forall i. GNodeInfo i => GNode i -> GNode i
+reduceBeta :: Node -> Node
 reduceBeta = umap go
   where
-    go :: GNode i -> GNode i
+    go :: Node -> Node
     go n = case n of
       App _ (Lambda _ body) arg -> subst arg body
       _ -> n
 
 -- substitution of all free variables for values in a closed environment
-substEnv :: GNodeInfo i => [GNode i] -> GNode i -> GNode i
+substEnv :: Env -> Node -> Node
 substEnv env = umapN go
   where
     go k n = case n of
       Var _ idx | idx >= k -> env !! k
       _ -> n
 
-removeClosures :: forall i. GNodeInfo i => GNode i -> GNode i
+removeClosures :: Node -> Node
 removeClosures = umap go
   where
-    go :: GNode i -> GNode i
+    go :: Node -> Node
     go n = case n of
       LambdaClosure i env b -> substEnv env (Lambda i b)
       _ -> n
diff --git a/src/Juvix/Core/Prelude.hs b/src/Juvix/Core/Prelude.hs
new file mode 100644
index 0000000000..e232bda695
--- /dev/null
+++ b/src/Juvix/Core/Prelude.hs
@@ -0,0 +1,18 @@
+module Juvix.Core.Prelude
+  ( module Juvix.Core.Builtins,
+    Info,
+    Key,
+    module Juvix.Prelude,
+    module Juvix.Prelude.Loc,
+    module Juvix.Syntax.Abstract.Name,
+    Location,
+  )
+where
+
+import Juvix.Core.Builtins
+import Juvix.Core.Info (Info, Key)
+import Juvix.Prelude
+import Juvix.Prelude.Loc
+import Juvix.Syntax.Abstract.Name
+
+type Location = Interval
diff --git a/src/Juvix/Core/Type.hs b/src/Juvix/Core/Type.hs
index 8e0a099543..60e5b62fd1 100644
--- a/src/Juvix/Core/Type.hs
+++ b/src/Juvix/Core/Type.hs
@@ -1,7 +1,6 @@
 module Juvix.Core.Type where
 
-import Juvix.Prelude
-import Juvix.Syntax.Abstract.Name
+import Juvix.Core.Prelude
 
 data Type = Atomic Atom | Fun Type Type | Universe
 

From 64a73660524600021c94bf1b5a77fa729f7e4d5f Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Thu, 28 Jul 2022 12:26:07 +0200
Subject: [PATCH 10/85] recursors redone

---
 src/Juvix/Core/Context.hs          |   3 +-
 src/Juvix/Core/Evaluator.hs        |  11 +-
 src/Juvix/Core/Info/BindingInfo.hs |  14 --
 src/Juvix/Core/Node.hs             | 326 ++++++++++++++++-------------
 src/Juvix/Core/Prelude.hs          |   9 +
 5 files changed, 199 insertions(+), 164 deletions(-)
 delete mode 100644 src/Juvix/Core/Info/BindingInfo.hs

diff --git a/src/Juvix/Core/Context.hs b/src/Juvix/Core/Context.hs
index 5a0868747f..f15ba77bd6 100644
--- a/src/Juvix/Core/Context.hs
+++ b/src/Juvix/Core/Context.hs
@@ -25,7 +25,8 @@ data IdentInfo = IdentInfo
     _identType :: Type,
     _identArgsNum :: Int,
     -- _identArgsNum will be used often enough to justify avoiding recomputation
-    _identArgsInfo :: [ArgumentInfo]
+    _identArgsInfo :: [ArgumentInfo],
+    _identIsExported :: Bool
   }
 
 data ArgumentInfo = ArgumentInfo
diff --git a/src/Juvix/Core/Evaluator.hs b/src/Juvix/Core/Evaluator.hs
index 95294f2298..cfb920edf9 100644
--- a/src/Juvix/Core/Evaluator.hs
+++ b/src/Juvix/Core/Evaluator.hs
@@ -1,8 +1,8 @@
 module Juvix.Core.Evaluator where
 
 import Data.HashMap.Strict ((!))
-import Juvix.Core.Info qualified as Info
 import Juvix.Core.Context
+import Juvix.Core.Info qualified as Info
 import Juvix.Core.Node
 import Juvix.Core.Prelude
 
@@ -48,10 +48,9 @@ eval !ctx = eval'
       Lambda i b -> LambdaClosure i env b
       LetIn _ v b -> let !v' = eval' env v in eval' (v' : env) b
       Case _ v bs ->
-        let !v' = eval' env v
-         in case v' of
-              Data _ tag args -> branch (args ++ env) tag bs
-              _ -> evalError
+        case eval' env v of
+          Data _ tag args -> branch (args ++ env) tag bs
+          _ -> evalError
       Data {} -> n
       LambdaClosure {} -> n
       Suspended {} -> n
@@ -82,6 +81,6 @@ eval !ctx = eval'
 
     branch :: Env -> Tag -> [CaseBranch] -> Node
     branch !env !tag = \case
-      (CaseBranch tag' b) : _ | tag' == tag -> eval' env b
+      (CaseBranch tag' _ b) : _ | tag' == tag -> eval' env b
       _ : bs' -> branch env tag bs'
       [] -> evalError
diff --git a/src/Juvix/Core/Info/BindingInfo.hs b/src/Juvix/Core/Info/BindingInfo.hs
deleted file mode 100644
index 2499558961..0000000000
--- a/src/Juvix/Core/Info/BindingInfo.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-module Juvix.Core.Info.BindingInfo where
-
-import Juvix.Core.Prelude
-import Juvix.Core.Type
-
-data BindingInfo = BindingInfo
-  { _infoName :: Name,
-    _infoType :: Type
-  }
-
-kBindingInfo :: Key BindingInfo
-kBindingInfo = Proxy
-
-makeLenses ''BindingInfo
diff --git a/src/Juvix/Core/Node.hs b/src/Juvix/Core/Node.hs
index 4fd2471d0f..8ca3e26885 100644
--- a/src/Juvix/Core/Node.hs
+++ b/src/Juvix/Core/Node.hs
@@ -8,7 +8,7 @@ module Juvix.Core.Node where
 import Data.Functor.Identity
 import Data.HashSet qualified as HashSet
 import Juvix.Core.Info qualified as Info
-import Juvix.Core.Info.BindingInfo
+import Juvix.Core.Info.BinderInfo
 import Juvix.Core.Prelude
 
 {---------------------------------------------------------------------------------}
@@ -57,7 +57,8 @@ data Node
     -- branches`. `Case` is lazy: only the selected branch is evaluated. Lazy `if`
     -- can be implemented by a case on a boolean.
     Case !Info !Node ![CaseBranch]
-  | -- Evaluation only: evaluated data constructor (the actual data).
+  | -- Evaluation only: evaluated data constructor (the actual data). Arguments
+    -- order: right to left.
     Data !Info !Tag ![Node]
   | -- Evaluation only: `LambdaClosure env body`
     LambdaClosure !Info !Env !Node
@@ -85,52 +86,15 @@ data Constant
 -- - ConstFloat
 -- - ConstString
 
-data CaseBranch = CaseBranch !Tag !Node
+-- `CaseBranch tag argsNum branch`
+-- - `argsNum` is the number of arguments of the constructor tagged with `tag`,
+--   equal to the number of implicit binders above `branch`
+data CaseBranch = CaseBranch !Tag !Int !Node
 
 -- all nodes in an environment must be closed (no free variables, i.e., de
 -- Bruijn indices pointing outside the term)
 type Env = [Node]
 
-{---------------------------------------------------------------------------------}
-{- Info -}
-
-getInfo :: Node -> Info
-getInfo = \case
-  Var i _ -> i
-  Ident i _ -> i
-  Builtin i _ -> i
-  Constructor i _ -> i
-  ConstValue i _ -> i
-  Hole i -> i
-  Axiom i -> i
-  App i _ _ -> i
-  Lambda i _ -> i
-  LetIn i _ _ -> i
-  Case i _ _ -> i
-  Data i _ _ -> i
-  LambdaClosure i _ _ -> i
-  Suspended i _ -> i
-
-modifyInfoM :: Applicative m => (Info -> m Info) -> Node -> m Node
-modifyInfoM f = \case
-  Var i idx -> Var <$> f i <*> pure idx
-  Ident i sym -> Ident <$> f i <*> pure sym
-  Builtin i op -> Builtin <$> f i <*> pure op
-  Constructor i tag -> Constructor <$> f i <*> pure tag
-  ConstValue i v -> ConstValue <$> f i <*> pure v
-  Hole i -> Hole <$> f i
-  Axiom i -> Axiom <$> f i
-  App i l r -> App <$> f i <*> pure l <*> pure r
-  Lambda i b -> Lambda <$> f i <*> pure b
-  LetIn i v b -> LetIn <$> f i <*> pure v <*> pure b
-  Case i v bs -> Case <$> f i <*> pure v <*> pure bs
-  Data i tag args -> Data <$> f i <*> pure tag <*> pure args
-  LambdaClosure i env b -> LambdaClosure <$> f i <*> pure env <*> pure b
-  Suspended i t -> Suspended <$> f i <*> pure t
-
-modifyInfo :: (Info -> Info) -> Node -> Node
-modifyInfo f n = runIdentity $ modifyInfoM (pure . f) n
-
 {---------------------------------------------------------------------------------}
 {- simple helper functions -}
 
@@ -148,43 +112,115 @@ unfoldApp = go []
       App i l r -> go ((i, r) : acc) l
       _ -> (n, acc)
 
+unfoldLambdas :: Node -> ([Info], Node)
+unfoldLambdas = go []
+  where
+    go :: [Info] -> Node -> ([Info], Node)
+    go acc n = case n of
+      Lambda i b -> go (i : acc) b
+      _ -> (acc, n)
+
+data NodeInfo = NodeInfo
+  { -- `nodeInfo` is the info associated with the node,
+    _nodeInfo :: Info,
+    -- `nodeChildren` are the children, in a fixed order, i.e., the immediate
+    -- recursive occurrences of Node
+    _nodeChildren :: [Node],
+    -- `nodeChildBindersNum` is the number of binders introduced for each child
+    -- in the parent node
+    _nodeChildBindersNum :: [Int],
+    -- `nodeChildBindersInfo` is information about binders for each child, if
+    -- present.
+    _nodeChildBindersInfo :: [Maybe [BinderInfo]],
+    -- `nodeReassemble` reassembles the node from the info and the children
+    -- (which should be in the same fixed order as in the `nodeChildren`
+    -- component).
+    _nodeReassemble :: Info -> [Node] -> Node
+  }
+
+makeLenses ''NodeInfo
+
+-- destruct a node into NodeInfo
+destruct :: Node -> NodeInfo
+destruct = \case
+  Var i idx -> NodeInfo i [] [] [] (\i' _ -> Var i' idx)
+  Ident i sym -> NodeInfo i [] [] [] (\i' _ -> Ident i' sym)
+  Builtin i op -> NodeInfo i [] [] [] (\i' _ -> Builtin i' op)
+  Constructor i tag -> NodeInfo i [] [] [] (\i' _ -> Constructor i' tag)
+  ConstValue i c -> NodeInfo i [] [] [] (\i' _ -> ConstValue i' c)
+  Hole i -> NodeInfo i [] [] [] (\i' _ -> Hole i')
+  Axiom i -> NodeInfo i [] [] [] (\i' _ -> Axiom i')
+  App i l r -> NodeInfo i [l, r] [0, 0] [Nothing, Nothing] (\i' args' -> App i' (hd args') (args' !! 1))
+  Lambda i b -> NodeInfo i [b] [1] [fetchBinderInfo i] (\i' args' -> Lambda i' (hd args'))
+  LetIn i v b -> NodeInfo i [v, b] [0, 1] [Nothing, fetchBinderInfo i] (\i' args' -> LetIn i' (hd args') (args' !! 1))
+  Case i v bs ->
+    NodeInfo
+      i
+      (v : map (\(CaseBranch _ _ br) -> br) bs)
+      (0 : map (\(CaseBranch _ k _) -> k) bs)
+      (Nothing : fetchCaseBinderInfo i (replicate (length bs) Nothing))
+      ( \i' args' ->
+          Case
+            i'
+            (hd args')
+            ( zipWithExact
+                (\(CaseBranch tag k _) br' -> CaseBranch tag k br')
+                bs
+                (tl args')
+            )
+      )
+  Data i tag args -> NodeInfo i args (map (const 0) args) [] (`Data` tag)
+  LambdaClosure i env b ->
+    NodeInfo
+      i
+      (b : env)
+      (1 : map (const 0) env)
+      [fetchBinderInfo i]
+      (\i' args' -> LambdaClosure i' (tl args') (hd args'))
+  Suspended i t -> NodeInfo i [t] [0] [] (\i' args' -> Suspended i' (hd args'))
+  where
+    fetchBinderInfo :: Info -> Maybe [BinderInfo]
+    fetchBinderInfo i = case Info.lookup kBinderInfo i of
+      Just bi -> Just [bi]
+      Nothing -> Nothing
+
+    fetchCaseBinderInfo :: Info -> [Maybe [BinderInfo]] -> [Maybe [BinderInfo]]
+    fetchCaseBinderInfo i d = case Info.lookup kCaseBinderInfo i of
+      Just cbi -> map Just (cbi ^. infoBranchBinders)
+      Nothing -> d
+
 children :: Node -> [Node]
-children = \case
-  App _ l r -> [l, r]
-  Lambda _ b -> [b]
-  LetIn _ v b -> [v, b]
-  Case _ v bs -> v : map (\(CaseBranch _ br) -> br) bs
-  Data _ _ args -> args
-  LambdaClosure _ env b -> b : env
-  Suspended _ t -> [t]
-  _ -> []
-
--- children not under binder
+children = (^. nodeChildren) . destruct
+
+-- children together with the number of binders
+bchildren :: Node -> [(Int, Node)]
+bchildren n =
+  let ni = destruct n
+   in zipExact (ni ^. nodeChildBindersNum) (ni ^. nodeChildren)
+
+-- shallow children: not under binders
 schildren :: Node -> [Node]
-schildren = \case
-  App _ l r -> [l, r]
-  LetIn _ v _ -> [v]
-  Case _ v bs -> v : map (\(CaseBranch _ br) -> br) bs
-  Data _ _ args -> args
-  LambdaClosure _ env _ -> env
-  Suspended _ t -> [t]
-  _ -> []
-
--- children under binder
-bchildren :: Node -> [Node]
-bchildren = \case
-  Lambda _ b -> [b]
-  LetIn _ _ b -> [b]
-  LambdaClosure _ _ b -> [b]
-  _ -> []
+schildren = map snd . filter (\p -> fst p == 0) . bchildren
+
+getInfo :: Node -> Info
+getInfo = (^. nodeInfo) . destruct
+
+modifyInfoM :: Applicative m => (Info -> m Info) -> Node -> m Node
+modifyInfoM f n =
+  let ni = destruct n
+   in do
+        i' <- f (ni ^. nodeInfo)
+        return ((ni ^. nodeReassemble) i' (ni ^. nodeChildren))
+
+modifyInfo :: (Info -> Info) -> Node -> Node
+modifyInfo f n = runIdentity $ modifyInfoM (pure . f) n
 
 {---------------------------------------------------------------------------------}
 {- General recursors on Node  -}
 
 -- Note: In the (distant) future, with dependent types, the type information
 -- will contain Nodes. Then mapping/folding needs to be performed also on the
--- Nodes stored as type information. This will require modifying type
--- information in the recursors below.
+-- Nodes stored as type information.
 
 -- a collector collects information top-down on a single path in the program
 -- tree
@@ -198,63 +234,52 @@ makeLenses ''Collector
 unitCollector :: Collector a ()
 unitCollector = Collector () (\_ _ -> ())
 
-bindingCollector :: Collector Info c -> Collector Node c
-bindingCollector coll = Collector (coll ^. cEmpty) collect
-  where
-    collect n c = case n of
-      Lambda i _ -> (coll ^. cCollect) i c
-      LetIn i _ _ -> (coll ^. cCollect) i c
-      LambdaClosure i _ _ -> (coll ^. cCollect) i c
-      _ -> c
-
-bindingInfoCollector :: Collector Node [Maybe BindingInfo]
-bindingInfoCollector =
-  bindingCollector
-    ( Collector
-        []
-        (\i c -> Info.lookup kBindingInfo i : c)
-    )
-
-bindingNumCollector :: Collector Node Index
-bindingNumCollector = bindingCollector (Collector 0 (const (+ 1)))
+binderInfoCollector :: Collector (Int, Maybe [BinderInfo]) [Maybe BinderInfo]
+binderInfoCollector =
+  Collector
+    []
+    (\(k, bi) c -> if k == 0 then c else map Just (fromJust bi) ++ c)
+
+binderNumCollector :: Collector (Int, Maybe [BinderInfo]) Index
+binderNumCollector = Collector 0 (\(k, _) c -> c + k)
 
 -- `umapG` maps the nodes bottom-up, i.e., when invoking the mapper function the
 -- recursive subnodes have already been mapped
 umapG ::
   forall c m.
   Monad m =>
-  Collector Node c ->
+  Collector (Int, Maybe [BinderInfo]) c ->
   (c -> Node -> m Node) ->
   Node ->
   m Node
 umapG coll f = go (coll ^. cEmpty)
   where
     go :: c -> Node -> m Node
-    go c n = case n of
-      App i l r -> f c =<< (App i <$> go c' l <*> go c' r)
-      Lambda i body -> f c . Lambda i =<< go c' body
-      LetIn i value body -> f c =<< (LetIn i <$> go c' value <*> go c' body)
-      Case i value bs -> f c =<< (Case i <$> go c' value <*> mapM (\(CaseBranch tag br) -> CaseBranch tag <$> go c' br) bs)
-      Data i tag args -> f c . Data i tag =<< mapM (go c') args
-      LambdaClosure i env body -> f c =<< (LambdaClosure i <$> mapM (go c') env <*> go c' body)
-      Suspended i t -> f c . Suspended i =<< go c' t
-      _ -> f c n
-      where
-        c' = (coll ^. cCollect) n c
+    go c n =
+      let ni = destruct n
+       in do
+            ns <-
+              sequence $
+                zipWith3Exact
+                  (\n' k bis -> go ((coll ^. cCollect) (k, bis) c) n')
+                  (ni ^. nodeChildren)
+                  (ni ^. nodeChildBindersNum)
+                  (ni ^. nodeChildBindersInfo)
+            f c ((ni ^. nodeReassemble) (ni ^. nodeInfo) ns)
 
 umapM :: Monad m => (Node -> m Node) -> Node -> m Node
 umapM f = umapG unitCollector (const f)
 
-umapMB :: Monad m => ([Maybe BindingInfo] -> Node -> m Node) -> Node -> m Node
-umapMB f = umapG bindingInfoCollector f
+umapMB :: Monad m => ([Maybe BinderInfo] -> Node -> m Node) -> Node -> m Node
+umapMB f = umapG binderInfoCollector f
 
 umapMN :: Monad m => (Index -> Node -> m Node) -> Node -> m Node
-umapMN f = umapG bindingNumCollector f
+umapMN f = umapG binderNumCollector f
 
 umap :: (Node -> Node) -> Node -> Node
 umap f n = runIdentity $ umapM (return . f) n
 
-umapB :: ([Maybe BindingInfo] -> Node -> Node) -> Node -> Node
+umapB :: ([Maybe BinderInfo] -> Node -> Node) -> Node -> Node
 umapB f n = runIdentity $ umapMB (\is -> return . f is) n
 
 umapN :: (Index -> Node -> Node) -> Node -> Node
@@ -264,11 +289,8 @@ umapN f n = runIdentity $ umapMN (\idx -> return . f idx) n
 dmapG ::
   forall c m.
   Monad m =>
-  Collector Node c ->
-  ( c ->
-    Node ->
-    m Node
-  ) ->
+  Collector (Int, Maybe [BinderInfo]) c ->
+  (c -> Node -> m Node) ->
   Node ->
   m Node
 dmapG coll f = go (coll ^. cEmpty)
@@ -276,30 +298,29 @@ dmapG coll f = go (coll ^. cEmpty)
     go :: c -> Node -> m Node
     go c n = do
       n' <- f c n
-      let c' = (coll ^. cCollect) n' c
-      case n' of
-        App i l r -> App i <$> go c' l <*> go c' r
-        Lambda i body -> Lambda i <$> go c' body
-        LetIn i value body -> LetIn i <$> go c' value <*> go c' body
-        Case i value bs -> Case i <$> go c' value <*> mapM (\(CaseBranch tag br) -> CaseBranch tag <$> go c' br) bs
-        Data i tag args -> Data i tag <$> mapM (go c') args
-        LambdaClosure i env body -> LambdaClosure i <$> mapM (go c') env <*> go c' body
-        Suspended i t -> Suspended i <$> go c' t
-        _ -> return n'
+      let ni = destruct n'
+      ns <-
+        sequence $
+          zipWith3Exact
+            (\n'' k bis -> go ((coll ^. cCollect) (k, bis) c) n'')
+            (ni ^. nodeChildren)
+            (ni ^. nodeChildBindersNum)
+            (ni ^. nodeChildBindersInfo)
+      return ((ni ^. nodeReassemble) (ni ^. nodeInfo) ns)
 
 dmapM :: Monad m => (Node -> m Node) -> Node -> m Node
 dmapM f = dmapG unitCollector (const f)
 
-dmapMB :: Monad m => ([Maybe BindingInfo] -> Node -> m Node) -> Node -> m Node
-dmapMB f = dmapG bindingInfoCollector f
+dmapMB :: Monad m => ([Maybe BinderInfo] -> Node -> m Node) -> Node -> m Node
+dmapMB f = dmapG binderInfoCollector f
 
 dmapMN :: Monad m => (Index -> Node -> m Node) -> Node -> m Node
-dmapMN f = dmapG bindingNumCollector f
+dmapMN f = dmapG binderNumCollector f
 
 dmap :: (Node -> Node) -> Node -> Node
 dmap f n = runIdentity $ dmapM (return . f) n
 
-dmapB :: ([Maybe BindingInfo] -> Node -> Node) -> Node -> Node
+dmapB :: ([Maybe BinderInfo] -> Node -> Node) -> Node -> Node
 dmapB f n = runIdentity $ dmapMB (\is -> return . f is) n
 
 dmapN :: (Index -> Node -> Node) -> Node -> Node
@@ -310,7 +331,7 @@ dmapN f n = runIdentity $ dmapMN (\idx -> return . f idx) n
 ufoldG ::
   forall c a m.
   Monad m =>
-  Collector Node c ->
+  Collector (Int, Maybe [BinderInfo]) c ->
   (a -> a -> a) ->
   (c -> Node -> m a) ->
   Node ->
@@ -318,31 +339,31 @@ ufoldG ::
 ufoldG coll uplus f = go (coll ^. cEmpty)
   where
     go :: c -> Node -> m a
-    go c n = case n of
-      App _ l r -> uplus <$> f c n <*> (uplus <$> go c' l <*> go c' r)
-      Lambda _ body -> uplus <$> f c n <*> go c' body
-      LetIn _ value body -> uplus <$> f c n <*> (uplus <$> go c' value <*> go c' body)
-      Case _ value bs -> uplus <$> f c n <*> foldr (liftM2 uplus . (\(CaseBranch _ br) -> go c' br)) (go c' value) bs
-      Data _ _ args -> foldr (liftM2 uplus . go c') (f c n) args
-      LambdaClosure _ env body -> uplus <$> f c n <*> foldr (liftM2 uplus . go c') (go c' body) env
-      Suspended _ t -> uplus <$> f c n <*> go c' t
-      _ -> f c n
+    go c n = foldr (liftM2 uplus) (f c n) mas
       where
-        c' = (coll ^. cCollect) n c
+        ni :: NodeInfo
+        ni = destruct n
+        mas :: [m a]
+        mas =
+          zipWith3Exact
+            (\n' k bis -> go ((coll ^. cCollect) (k, bis) c) n')
+            (ni ^. nodeChildren)
+            (ni ^. nodeChildBindersNum)
+            (ni ^. nodeChildBindersInfo)
 
 ufoldM :: Monad m => (a -> a -> a) -> (Node -> m a) -> Node -> m a
 ufoldM uplus f = ufoldG unitCollector uplus (const f)
 
-ufoldMB :: Monad m => (a -> a -> a) -> ([Maybe BindingInfo] -> Node -> m a) -> Node -> m a
-ufoldMB uplus f = ufoldG bindingInfoCollector uplus f
+ufoldMB :: Monad m => (a -> a -> a) -> ([Maybe BinderInfo] -> Node -> m a) -> Node -> m a
+ufoldMB uplus f = ufoldG binderInfoCollector uplus f
 
 ufoldMN :: Monad m => (a -> a -> a) -> (Index -> Node -> m a) -> Node -> m a
-ufoldMN uplus f = ufoldG bindingNumCollector uplus f
+ufoldMN uplus f = ufoldG binderNumCollector uplus f
 
 ufold :: (a -> a -> a) -> (Node -> a) -> Node -> a
 ufold uplus f n = runIdentity $ ufoldM uplus (return . f) n
 
-ufoldB :: (a -> a -> a) -> ([Maybe BindingInfo] -> Node -> a) -> Node -> a
+ufoldB :: (a -> a -> a) -> ([Maybe BinderInfo] -> Node -> a) -> Node -> a
 ufoldB uplus f n = runIdentity $ ufoldMB uplus (\is -> return . f is) n
 
 ufoldN :: (a -> a -> a) -> (Index -> Node -> a) -> Node -> a
@@ -351,7 +372,7 @@ ufoldN uplus f n = runIdentity $ ufoldMN uplus (\idx -> return . f idx) n
 walk :: Monad m => (Node -> m ()) -> Node -> m ()
 walk = ufoldM mappend
 
-walkB :: Monad m => ([Maybe BindingInfo] -> Node -> m ()) -> Node -> m ()
+walkB :: Monad m => ([Maybe BinderInfo] -> Node -> m ()) -> Node -> m ()
 walkB = ufoldMB mappend
 
 walkN :: Monad m => (Index -> Node -> m ()) -> Node -> m ()
@@ -360,7 +381,7 @@ walkN = ufoldMN mappend
 gather :: (a -> Node -> a) -> a -> Node -> a
 gather f acc n = fst $ run $ runState acc (walk (\n' -> modify (`f` n')) n)
 
-gatherB :: ([Maybe BindingInfo] -> a -> Node -> a) -> a -> Node -> a
+gatherB :: ([Maybe BinderInfo] -> a -> Node -> a) -> a -> Node -> a
 gatherB f acc n = fst $ run $ runState acc (walkB (\is n' -> modify (\a -> f is a n')) n)
 
 gatherN :: (Index -> a -> Node -> a) -> a -> Node -> a
@@ -442,3 +463,22 @@ removeClosures = umap go
     go n = case n of
       LambdaClosure i env b -> substEnv env (Lambda i b)
       _ -> n
+
+removeData :: Node -> Node
+removeData = umap go
+  where
+    go :: Node -> Node
+    go n = case n of
+      Data i tag args -> mkApp' (Constructor i tag) args
+      _ -> n
+
+removeSuspended :: Node -> Node
+removeSuspended = umap go
+  where
+    go :: Node -> Node
+    go n = case n of
+      Suspended _ t -> t
+      _ -> n
+
+removeRuntimeNodes :: Node -> Node
+removeRuntimeNodes = removeSuspended . removeData . removeClosures
diff --git a/src/Juvix/Core/Prelude.hs b/src/Juvix/Core/Prelude.hs
index e232bda695..cde7fc9e95 100644
--- a/src/Juvix/Core/Prelude.hs
+++ b/src/Juvix/Core/Prelude.hs
@@ -6,6 +6,8 @@ module Juvix.Core.Prelude
     module Juvix.Prelude.Loc,
     module Juvix.Syntax.Abstract.Name,
     Location,
+    hd,
+    tl
   )
 where
 
@@ -14,5 +16,12 @@ import Juvix.Core.Info (Info, Key)
 import Juvix.Prelude
 import Juvix.Prelude.Loc
 import Juvix.Syntax.Abstract.Name
+import Data.List qualified as List
 
 type Location = Interval
+
+hd :: [a] -> a
+hd = List.head
+
+tl :: [a] -> [a]
+tl = List.tail

From 7003544a6e3024b5054f3bc1996f3c82455f3239 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Thu, 28 Jul 2022 13:21:05 +0200
Subject: [PATCH 11/85] info types

---
 src/Juvix/Core/Context.hs               |  1 -
 src/Juvix/Core/Evaluator.hs             |  2 +-
 src/Juvix/Core/Info/BinderInfo.hs       | 22 ++++++++++++
 src/Juvix/Core/Info/FreeVariableInfo.hs | 26 --------------
 src/Juvix/Core/Info/FreeVarsInfo.hs     | 48 +++++++++++++++++++++++++
 src/Juvix/Core/Info/IdentInfo.hs        | 16 ++++-----
 6 files changed, 78 insertions(+), 37 deletions(-)
 create mode 100644 src/Juvix/Core/Info/BinderInfo.hs
 delete mode 100644 src/Juvix/Core/Info/FreeVariableInfo.hs
 create mode 100644 src/Juvix/Core/Info/FreeVarsInfo.hs

diff --git a/src/Juvix/Core/Context.hs b/src/Juvix/Core/Context.hs
index f15ba77bd6..db5d941801 100644
--- a/src/Juvix/Core/Context.hs
+++ b/src/Juvix/Core/Context.hs
@@ -33,7 +33,6 @@ data ArgumentInfo = ArgumentInfo
   { _argName :: Name,
     _argType :: Type,
     _argIsImplicit :: Bool
-    -- future: _argIsLazy :: Bool
   }
 
 data InductiveInfo = InductiveInfo
diff --git a/src/Juvix/Core/Evaluator.hs b/src/Juvix/Core/Evaluator.hs
index cfb920edf9..1d0a00c0b6 100644
--- a/src/Juvix/Core/Evaluator.hs
+++ b/src/Juvix/Core/Evaluator.hs
@@ -9,7 +9,7 @@ import Juvix.Core.Prelude
 -- `eval ctx env n` evalues a node `n` whose all free variables point into
 -- `env`. All nodes in `ctx` and `env` are closed.
 eval :: IdentContext -> Env -> Node -> Node
-eval !ctx = eval'
+eval !ctx !env0 = removeRuntimeNodes . eval' env0
   where
     unimplemented :: a
     unimplemented = error "not yet implemented"
diff --git a/src/Juvix/Core/Info/BinderInfo.hs b/src/Juvix/Core/Info/BinderInfo.hs
new file mode 100644
index 0000000000..3159a4e6ed
--- /dev/null
+++ b/src/Juvix/Core/Info/BinderInfo.hs
@@ -0,0 +1,22 @@
+module Juvix.Core.Info.BinderInfo where
+
+import Juvix.Core.Prelude
+import Juvix.Core.Type
+
+data BinderInfo = BinderInfo
+  { _infoName :: Name,
+    _infoType :: Type
+  }
+
+kBinderInfo :: Key BinderInfo
+kBinderInfo = Proxy
+
+newtype CaseBinderInfo = CaseBinderInfo
+  { _infoBranchBinders :: [[BinderInfo]]
+  }
+
+kCaseBinderInfo :: Key CaseBinderInfo
+kCaseBinderInfo = Proxy
+
+makeLenses ''BinderInfo
+makeLenses ''CaseBinderInfo
diff --git a/src/Juvix/Core/Info/FreeVariableInfo.hs b/src/Juvix/Core/Info/FreeVariableInfo.hs
deleted file mode 100644
index 6ee04fcfc2..0000000000
--- a/src/Juvix/Core/Info/FreeVariableInfo.hs
+++ /dev/null
@@ -1,26 +0,0 @@
-module Juvix.Core.Info.FreeVariableInfo where
-
-import Data.HashMap.Strict as HashMap
-import Juvix.Core.Info qualified as Info
-import Juvix.Core.Node
-import Juvix.Core.Prelude
-
-newtype FreeVariableInfo = FreeVariableInfo
-  { -- map free variables to the number of their occurrences
-    _infoFreeVars :: HashMap Index Int
-  }
-
-kFreeVariableInfo :: Key FreeVariableInfo
-kFreeVariableInfo = Proxy
-
-makeLenses ''FreeVariableInfo
-
-computeFreeVariableInfo :: Node -> Node
-computeFreeVariableInfo = umapN go
-  where
-    go :: Index -> Node -> Node
-    go k n = case n of
-      Var i idx | idx >= k -> Var (Info.insert fvi i) idx
-        where
-          fvi = FreeVariableInfo (HashMap.singleton (idx - k) 1)
-      _ -> undefined
diff --git a/src/Juvix/Core/Info/FreeVarsInfo.hs b/src/Juvix/Core/Info/FreeVarsInfo.hs
new file mode 100644
index 0000000000..edb03b3c86
--- /dev/null
+++ b/src/Juvix/Core/Info/FreeVarsInfo.hs
@@ -0,0 +1,48 @@
+module Juvix.Core.Info.FreeVarsInfo where
+
+-- NOTE: IntMap could be better here and in other places in terms of performance
+-- (by a constant factor). This might matter (but not very much) in the future -
+-- we will be running these transformations on core representations of entire
+-- Juvix functions (or even bigger units of compilation).
+import Data.HashMap.Strict qualified as HashMap
+import Juvix.Core.Info qualified as Info
+import Juvix.Core.Node
+import Juvix.Core.Prelude
+
+newtype FreeVarsInfo = FreeVarsInfo
+  { -- map free variables to the number of their occurrences
+    _infoFreeVars :: HashMap Index Int
+  }
+
+kFreeVarsInfo :: Key FreeVarsInfo
+kFreeVarsInfo = Proxy
+
+makeLenses ''FreeVarsInfo
+
+computeFreeVarsInfo :: Node -> Node
+computeFreeVarsInfo = umapN go
+  where
+    go :: Index -> Node -> Node
+    go k n = case n of
+      Var i idx | idx >= k -> Var (Info.insert fvi i) idx
+        where
+          fvi = FreeVarsInfo (HashMap.singleton (idx - k) 1)
+      _ -> modifyInfo (Info.insert fvi) n
+        where
+          fvi =
+            FreeVarsInfo $
+              HashMap.unions $
+                map
+                  ( \(m, n') ->
+                      HashMap.mapKeys (\j -> j - m) $
+                        HashMap.filterWithKey
+                          (\j _ -> j < m)
+                          (getFreeVarsInfo n' ^. infoFreeVars)
+                  )
+                  (bchildren n)
+
+getFreeVarsInfo :: Node -> FreeVarsInfo
+getFreeVarsInfo = fromJust . Info.lookup kFreeVarsInfo . getInfo
+
+freeVarOccurrences :: Index -> Node -> Int
+freeVarOccurrences idx n = fromMaybe 0 (HashMap.lookup idx (getFreeVarsInfo n ^. infoFreeVars))
diff --git a/src/Juvix/Core/Info/IdentInfo.hs b/src/Juvix/Core/Info/IdentInfo.hs
index 0c3315937b..d24c94e53b 100644
--- a/src/Juvix/Core/Info/IdentInfo.hs
+++ b/src/Juvix/Core/Info/IdentInfo.hs
@@ -28,12 +28,10 @@ computeIdentInfo = umap go
           fvi =
             IdentInfo $
               HashMap.unions
-                ( map
-                    ( \n' ->
-                        Info.lookupDefault
-                          (IdentInfo mempty)
-                          (getInfo n')
-                          ^. infoIdents
-                    )
-                    (children n)
-                )
+                (map ((^. infoIdents) . getIdentInfo) (children n))
+
+getIdentInfo :: Node -> IdentInfo
+getIdentInfo = Info.lookupDefault (IdentInfo mempty) . getInfo
+
+identOccurrences :: Symbol -> Node -> Int
+identOccurrences sym = fromMaybe 0 . HashMap.lookup sym . (^. infoIdents) . getIdentInfo

From 87627804f0510024d597182507cef017e9f165ec Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Thu, 28 Jul 2022 13:43:42 +0200
Subject: [PATCH 12/85] comments

---
 src/Juvix/Core/Context.hs   | 10 +++++-----
 src/Juvix/Core/Evaluator.hs |  2 +-
 src/Juvix/Core/Node.hs      | 34 ++++++++++++++++++----------------
 3 files changed, 24 insertions(+), 22 deletions(-)

diff --git a/src/Juvix/Core/Context.hs b/src/Juvix/Core/Context.hs
index db5d941801..aa74746ac1 100644
--- a/src/Juvix/Core/Context.hs
+++ b/src/Juvix/Core/Context.hs
@@ -9,11 +9,11 @@ type IdentContext = HashMap Symbol Node
 data Context = Context
   { _identContext :: IdentContext,
     _identInfo :: HashMap Symbol IdentInfo,
-    -- We reuse `Name` for runtime-irrelevant identifiers (inductive type names,
-    -- axiom names, etc). We shouldn't do this for Symbol and Tag, because we
-    -- need them "small", consecutive and separate for the code generator.
-    -- Discuss: advantages/disadvantages of doing this separation later in the
-    -- pipeline.
+    -- We reuse `Name` from Juvix.Syntax.Abstract for runtime-irrelevant
+    -- identifiers (inductive type names, axiom names, etc). We shouldn't do
+    -- this for Symbol and Tag, because we need them "small", consecutive and
+    -- separate for the code generator. Discuss: advantages/disadvantages of
+    -- doing this separation later in the pipeline.
     _inductiveInfo :: HashMap Name InductiveInfo,
     _constructorInfo :: HashMap Tag ConstructorInfo,
     _axiomInfo :: HashMap Name AxiomInfo
diff --git a/src/Juvix/Core/Evaluator.hs b/src/Juvix/Core/Evaluator.hs
index 1d0a00c0b6..2161f73def 100644
--- a/src/Juvix/Core/Evaluator.hs
+++ b/src/Juvix/Core/Evaluator.hs
@@ -9,7 +9,7 @@ import Juvix.Core.Prelude
 -- `eval ctx env n` evalues a node `n` whose all free variables point into
 -- `env`. All nodes in `ctx` and `env` are closed.
 eval :: IdentContext -> Env -> Node -> Node
-eval !ctx !env0 = removeRuntimeNodes . eval' env0
+eval !ctx !env0 = convertRuntimeNodes . eval' env0
   where
     unimplemented :: a
     unimplemented = error "not yet implemented"
diff --git a/src/Juvix/Core/Node.hs b/src/Juvix/Core/Node.hs
index 8ca3e26885..2b546a96e7 100644
--- a/src/Juvix/Core/Node.hs
+++ b/src/Juvix/Core/Node.hs
@@ -1,7 +1,7 @@
 module Juvix.Core.Node where
 
 {-
-  This file defines the graph representation of JuvixCore (Node datatype) and
+  This file defines the tree representation of JuvixCore (Node datatype) and
   general recursors on it.
 -}
 
@@ -12,7 +12,7 @@ import Juvix.Core.Info.BinderInfo
 import Juvix.Core.Prelude
 
 {---------------------------------------------------------------------------------}
-{- Program graph datatype -}
+{- Program tree datatype -}
 
 -- Consecutive symbol IDs for reachable user functions.
 type Symbol = Word
@@ -27,7 +27,7 @@ data Tag = BuiltinTag BuiltinDataTag | UserTag Word
 -- de Bruijn index
 type Index = Int
 
--- `Node` is the type of nodes in the program graph. The nodes themselves
+-- `Node` is the type of nodes in the program tree. The nodes themselves
 -- contain only runtime-relevant information. Runtime-irrelevant annotations
 -- (including all type information) are stored in the infos associated with each
 -- each.
@@ -43,7 +43,7 @@ data Node
     Builtin !Info !BuiltinOp
   | -- A data constructor (the function that creates the data).
     Constructor !Info !Tag
-  | ConstValue !Info {-# UNPACK #-} !Constant
+  | ConstValue !Info !Constant
   | -- A hole. It's a unit for the purposes of evaluation.
     Hole !Info
   | -- An axiom. Computationally a unit.
@@ -120,6 +120,8 @@ unfoldLambdas = go []
       Lambda i b -> go (i : acc) b
       _ -> (acc, n)
 
+-- `NodeInfo` is a convenience datatype which provides the most commonly needed
+-- information about a node in a generic fashion.
 data NodeInfo = NodeInfo
   { -- `nodeInfo` is the info associated with the node,
     _nodeInfo :: Info,
@@ -127,10 +129,10 @@ data NodeInfo = NodeInfo
     -- recursive occurrences of Node
     _nodeChildren :: [Node],
     -- `nodeChildBindersNum` is the number of binders introduced for each child
-    -- in the parent node
+    -- in the parent node. Same length and order as in `nodeChildren`.
     _nodeChildBindersNum :: [Int],
     -- `nodeChildBindersInfo` is information about binders for each child, if
-    -- present.
+    -- present. Same length and order as in `nodeChildren`.
     _nodeChildBindersInfo :: [Maybe [BinderInfo]],
     -- `nodeReassemble` reassembles the node from the info and the children
     -- (which should be in the same fixed order as in the `nodeChildren`
@@ -326,8 +328,8 @@ dmapB f n = runIdentity $ dmapMB (\is -> return . f is) n
 dmapN :: (Index -> Node -> Node) -> Node -> Node
 dmapN f n = runIdentity $ dmapMN (\idx -> return . f idx) n
 
--- `ufoldG` folds the tree bottom-up; `uplus` combines the values - it should be
--- commutative and associative
+-- `ufoldG` folds the tree bottom-up. The `uplus` argument combines the values -
+-- it should be commutative and associative.
 ufoldG ::
   forall c a m.
   Monad m =>
@@ -456,29 +458,29 @@ substEnv env = umapN go
       Var _ idx | idx >= k -> env !! k
       _ -> n
 
-removeClosures :: Node -> Node
-removeClosures = umap go
+convertClosures :: Node -> Node
+convertClosures = umap go
   where
     go :: Node -> Node
     go n = case n of
       LambdaClosure i env b -> substEnv env (Lambda i b)
       _ -> n
 
-removeData :: Node -> Node
-removeData = umap go
+convertData :: Node -> Node
+convertData = umap go
   where
     go :: Node -> Node
     go n = case n of
       Data i tag args -> mkApp' (Constructor i tag) args
       _ -> n
 
-removeSuspended :: Node -> Node
-removeSuspended = umap go
+convertSuspended :: Node -> Node
+convertSuspended = umap go
   where
     go :: Node -> Node
     go n = case n of
       Suspended _ t -> t
       _ -> n
 
-removeRuntimeNodes :: Node -> Node
-removeRuntimeNodes = removeSuspended . removeData . removeClosures
+convertRuntimeNodes :: Node -> Node
+convertRuntimeNodes = convertSuspended . convertData . convertClosures

From 06d7959830ce9c24930f03cef302d850b4c5ee74 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Thu, 28 Jul 2022 17:07:29 +0200
Subject: [PATCH 13/85] lazy if & default case branch

---
 src/Juvix/Core/Evaluator.hs | 19 ++++++++++-----
 src/Juvix/Core/Node.hs      | 46 +++++++++++++++++++++++++++++--------
 2 files changed, 50 insertions(+), 15 deletions(-)

diff --git a/src/Juvix/Core/Evaluator.hs b/src/Juvix/Core/Evaluator.hs
index 2161f73def..4b15880953 100644
--- a/src/Juvix/Core/Evaluator.hs
+++ b/src/Juvix/Core/Evaluator.hs
@@ -47,9 +47,14 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
         apply env l r []
       Lambda i b -> LambdaClosure i env b
       LetIn _ v b -> let !v' = eval' env v in eval' (v' : env) b
-      Case _ v bs ->
+      Case _ v bs def ->
         case eval' env v of
-          Data _ tag args -> branch (args ++ env) tag bs
+          Data _ tag args -> branch env (args ++ env) tag def bs
+          _ -> evalError
+      If _ v b1 b2 ->
+        case eval' env v of
+          ConstValue _ (ConstBool True) -> eval' env b1
+          ConstValue _ (ConstBool False) -> eval' env b2
           _ -> evalError
       Data {} -> n
       LambdaClosure {} -> n
@@ -79,8 +84,10 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
       a : args' -> push env env' n a args'
       [] -> eval' env' n
 
-    branch :: Env -> Tag -> [CaseBranch] -> Node
-    branch !env !tag = \case
+    branch :: Env -> Env -> Tag -> Maybe Node -> [CaseBranch] -> Node
+    branch !denv !env !tag !def = \case
       (CaseBranch tag' _ b) : _ | tag' == tag -> eval' env b
-      _ : bs' -> branch env tag bs'
-      [] -> evalError
+      _ : bs' -> branch denv env tag def bs'
+      [] -> case def of
+        Just b -> eval' denv b
+        Nothing -> evalError
diff --git a/src/Juvix/Core/Node.hs b/src/Juvix/Core/Node.hs
index 2b546a96e7..0618b93022 100644
--- a/src/Juvix/Core/Node.hs
+++ b/src/Juvix/Core/Node.hs
@@ -30,14 +30,14 @@ type Index = Int
 -- `Node` is the type of nodes in the program tree. The nodes themselves
 -- contain only runtime-relevant information. Runtime-irrelevant annotations
 -- (including all type information) are stored in the infos associated with each
--- each.
+-- node.
 data Node
   = -- De Bruijn index of a locally lambda-bound variable.
     Var !Info !Index
-  | -- Global identifier of a function (with corresponding `GNode` in the global
+  | -- Global identifier of a function (with corresponding `Node` in the global
     -- context).
     Ident !Info !Symbol
-  | -- A builtin with no corresponding GNode, treated specially by the evaluator
+  | -- A builtin with no corresponding Node, treated specially by the evaluator
     -- and the code generator. For example, basic arithmetic operations go into
     -- `Builtin`.
     Builtin !Info !BuiltinOp
@@ -54,9 +54,11 @@ data Node
     -- of ML-polymorphic / dependent type checking or code generation!
     LetIn !Info !Node !Node
   | -- One-level case matching on the tag of a data constructor: `Case value
-    -- branches`. `Case` is lazy: only the selected branch is evaluated. Lazy `if`
-    -- can be implemented by a case on a boolean.
-    Case !Info !Node ![CaseBranch]
+    -- branches default`. `Case` is lazy: only the selected branch is evaluated.
+    Case !Info !Node ![CaseBranch] !(Maybe Node)
+  | -- Lazy `if` on booleans. It is reasonable to separate booleans from general
+    -- datatypes for the purposes of evaluation and code generation.
+    If !Info !Node !Node !Node
   | -- Evaluation only: evaluated data constructor (the actual data). Arguments
     -- order: right to left.
     Data !Info !Tag ![Node]
@@ -155,7 +157,7 @@ destruct = \case
   App i l r -> NodeInfo i [l, r] [0, 0] [Nothing, Nothing] (\i' args' -> App i' (hd args') (args' !! 1))
   Lambda i b -> NodeInfo i [b] [1] [fetchBinderInfo i] (\i' args' -> Lambda i' (hd args'))
   LetIn i v b -> NodeInfo i [v, b] [0, 1] [Nothing, fetchBinderInfo i] (\i' args' -> LetIn i' (hd args') (args' !! 1))
-  Case i v bs ->
+  Case i v bs Nothing ->
     NodeInfo
       i
       (v : map (\(CaseBranch _ _ br) -> br) bs)
@@ -170,8 +172,34 @@ destruct = \case
                 bs
                 (tl args')
             )
+            Nothing
       )
-  Data i tag args -> NodeInfo i args (map (const 0) args) [] (`Data` tag)
+  Case i v bs (Just def) ->
+    NodeInfo
+      i
+      (v : def : map (\(CaseBranch _ _ br) -> br) bs)
+      (0 : 0 : map (\(CaseBranch _ k _) -> k) bs)
+      (Nothing : Nothing : fetchCaseBinderInfo i (replicate (length bs) Nothing))
+      ( \i' args' ->
+          Case
+            i'
+            (hd args')
+            ( zipWithExact
+                (\(CaseBranch tag k _) br' -> CaseBranch tag k br')
+                bs
+                (tl (tl args'))
+            )
+            (Just (hd (tl args')))
+      )
+  If i v b1 b2 ->
+    NodeInfo
+      i
+      [v, b1, b2]
+      [0, 0, 0]
+      [Nothing, Nothing, Nothing]
+      (\i' args' -> If i' (hd args') (args' !! 1) (args' !! 2))
+  Data i tag args ->
+    NodeInfo i args (map (const 0) args) (map (const Nothing) args) (`Data` tag)
   LambdaClosure i env b ->
     NodeInfo
       i
@@ -179,7 +207,7 @@ destruct = \case
       (1 : map (const 0) env)
       [fetchBinderInfo i]
       (\i' args' -> LambdaClosure i' (tl args') (hd args'))
-  Suspended i t -> NodeInfo i [t] [0] [] (\i' args' -> Suspended i' (hd args'))
+  Suspended i t -> NodeInfo i [t] [0] [Nothing] (\i' args' -> Suspended i' (hd args'))
   where
     fetchBinderInfo :: Info -> Maybe [BinderInfo]
     fetchBinderInfo i = case Info.lookup kBinderInfo i of

From 4ae7ef8ced5db4bae9ddb49d2353a7e4b0ff9ccb Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Fri, 29 Jul 2022 09:22:05 +0200
Subject: [PATCH 14/85] fix computeFreeVarsInfo & computeIdentInfo

---
 src/Juvix/Core/Builtins.hs          |  4 ++--
 src/Juvix/Core/Info/FreeVarsInfo.hs | 11 ++++++-----
 src/Juvix/Core/Info/IdentInfo.hs    |  6 ++++--
 src/Juvix/Core/Info/LocationInfo.hs |  2 +-
 src/Juvix/Core/Info/NameInfo.hs     |  2 +-
 src/Juvix/Core/Info/TypeInfo.hs     |  2 +-
 src/Juvix/Core/Prelude.hs           |  4 ++--
 src/Juvix/Core/Type.hs              |  2 +-
 8 files changed, 18 insertions(+), 15 deletions(-)

diff --git a/src/Juvix/Core/Builtins.hs b/src/Juvix/Core/Builtins.hs
index cfce346d79..5361c82c40 100644
--- a/src/Juvix/Core/Builtins.hs
+++ b/src/Juvix/Core/Builtins.hs
@@ -23,8 +23,8 @@ data BuiltinOp
   deriving stock (Eq)
 
 -- Builtin data tags
-data BuiltinDataTag =
-    TagZero
+data BuiltinDataTag
+  = TagZero
   | TagSucc
   | TagUnit
   | TagNil
diff --git a/src/Juvix/Core/Info/FreeVarsInfo.hs b/src/Juvix/Core/Info/FreeVarsInfo.hs
index edb03b3c86..df13559005 100644
--- a/src/Juvix/Core/Info/FreeVarsInfo.hs
+++ b/src/Juvix/Core/Info/FreeVarsInfo.hs
@@ -31,15 +31,16 @@ computeFreeVarsInfo = umapN go
         where
           fvi =
             FreeVarsInfo $
-              HashMap.unions $
-                map
-                  ( \(m, n') ->
+              foldr
+                ( \(m, n') acc ->
+                    HashMap.unionWith (+) acc $
                       HashMap.mapKeys (\j -> j - m) $
                         HashMap.filterWithKey
                           (\j _ -> j < m)
                           (getFreeVarsInfo n' ^. infoFreeVars)
-                  )
-                  (bchildren n)
+                )
+                mempty
+                (bchildren n)
 
 getFreeVarsInfo :: Node -> FreeVarsInfo
 getFreeVarsInfo = fromJust . Info.lookup kFreeVarsInfo . getInfo
diff --git a/src/Juvix/Core/Info/IdentInfo.hs b/src/Juvix/Core/Info/IdentInfo.hs
index d24c94e53b..4b893300f4 100644
--- a/src/Juvix/Core/Info/IdentInfo.hs
+++ b/src/Juvix/Core/Info/IdentInfo.hs
@@ -27,8 +27,10 @@ computeIdentInfo = umap go
         where
           fvi =
             IdentInfo $
-              HashMap.unions
-                (map ((^. infoIdents) . getIdentInfo) (children n))
+              foldr
+                (HashMap.unionWith (+) . (^. infoIdents) . getIdentInfo)
+                mempty
+                (children n)
 
 getIdentInfo :: Node -> IdentInfo
 getIdentInfo = Info.lookupDefault (IdentInfo mempty) . getInfo
diff --git a/src/Juvix/Core/Info/LocationInfo.hs b/src/Juvix/Core/Info/LocationInfo.hs
index 3286d5918d..741e460cfe 100644
--- a/src/Juvix/Core/Info/LocationInfo.hs
+++ b/src/Juvix/Core/Info/LocationInfo.hs
@@ -2,7 +2,7 @@ module Juvix.Core.Info.LocationInfo where
 
 import Juvix.Core.Prelude
 
-newtype LocationInfo = LocationInfo { _infoLocation :: Location }
+newtype LocationInfo = LocationInfo {_infoLocation :: Location}
 
 kLocationInfo :: Key LocationInfo
 kLocationInfo = Proxy
diff --git a/src/Juvix/Core/Info/NameInfo.hs b/src/Juvix/Core/Info/NameInfo.hs
index 265b8eb281..a33be004d3 100644
--- a/src/Juvix/Core/Info/NameInfo.hs
+++ b/src/Juvix/Core/Info/NameInfo.hs
@@ -2,7 +2,7 @@ module Juvix.Core.Info.NameInfo where
 
 import Juvix.Core.Prelude
 
-newtype NameInfo = NameInfo { _infoName :: Name }
+newtype NameInfo = NameInfo {_infoName :: Name}
 
 kNameInfo :: Key NameInfo
 kNameInfo = Proxy
diff --git a/src/Juvix/Core/Info/TypeInfo.hs b/src/Juvix/Core/Info/TypeInfo.hs
index 76cb33907c..1660e1f689 100644
--- a/src/Juvix/Core/Info/TypeInfo.hs
+++ b/src/Juvix/Core/Info/TypeInfo.hs
@@ -3,7 +3,7 @@ module Juvix.Core.Info.TypeInfo where
 import Juvix.Core.Prelude
 import Juvix.Core.Type
 
-newtype TypeInfo = TypeInfo { _infoType :: Type }
+newtype TypeInfo = TypeInfo {_infoType :: Type}
 
 kTypeInfo :: Key TypeInfo
 kTypeInfo = Proxy
diff --git a/src/Juvix/Core/Prelude.hs b/src/Juvix/Core/Prelude.hs
index cde7fc9e95..0401ecad79 100644
--- a/src/Juvix/Core/Prelude.hs
+++ b/src/Juvix/Core/Prelude.hs
@@ -7,16 +7,16 @@ module Juvix.Core.Prelude
     module Juvix.Syntax.Abstract.Name,
     Location,
     hd,
-    tl
+    tl,
   )
 where
 
+import Data.List qualified as List
 import Juvix.Core.Builtins
 import Juvix.Core.Info (Info, Key)
 import Juvix.Prelude
 import Juvix.Prelude.Loc
 import Juvix.Syntax.Abstract.Name
-import Data.List qualified as List
 
 type Location = Interval
 
diff --git a/src/Juvix/Core/Type.hs b/src/Juvix/Core/Type.hs
index 60e5b62fd1..350576cc40 100644
--- a/src/Juvix/Core/Type.hs
+++ b/src/Juvix/Core/Type.hs
@@ -14,7 +14,7 @@ makeLenses ''Atom
 -- unfold a type into the target and the arguments (left-to-right)
 unfoldType :: Type -> (Type, [Type])
 unfoldType ty = case ty of
-  Fun l r -> let (tgt, args) = unfoldType r in (tgt, l:args)
+  Fun l r -> let (tgt, args) = unfoldType r in (tgt, l : args)
   _ -> (ty, [])
 
 getTarget :: Type -> Type

From 24140d3f1de7dab7a2f51519643551ebd6d49dca Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Fri, 29 Jul 2022 09:52:58 +0200
Subject: [PATCH 15/85] comments

---
 src/Juvix/Core/Info.hs              |  5 +++++
 src/Juvix/Core/Info/FreeVarsInfo.hs |  4 ----
 src/Juvix/Core/Node.hs              | 16 +++++++++-------
 3 files changed, 14 insertions(+), 11 deletions(-)

diff --git a/src/Juvix/Core/Info.hs b/src/Juvix/Core/Info.hs
index 1dc4095094..c702d00889 100644
--- a/src/Juvix/Core/Info.hs
+++ b/src/Juvix/Core/Info.hs
@@ -1,5 +1,10 @@
 module Juvix.Core.Info where
 
+{-
+  This file defines the type of Info stored in JuvixCore Nodes. The Info data
+  structure maps an info type to an info of that type.
+-}
+
 import Data.Dynamic
 import Data.HashMap.Strict qualified as HashMap
 import Juvix.Prelude
diff --git a/src/Juvix/Core/Info/FreeVarsInfo.hs b/src/Juvix/Core/Info/FreeVarsInfo.hs
index df13559005..aa84138547 100644
--- a/src/Juvix/Core/Info/FreeVarsInfo.hs
+++ b/src/Juvix/Core/Info/FreeVarsInfo.hs
@@ -1,9 +1,5 @@
 module Juvix.Core.Info.FreeVarsInfo where
 
--- NOTE: IntMap could be better here and in other places in terms of performance
--- (by a constant factor). This might matter (but not very much) in the future -
--- we will be running these transformations on core representations of entire
--- Juvix functions (or even bigger units of compilation).
 import Data.HashMap.Strict qualified as HashMap
 import Juvix.Core.Info qualified as Info
 import Juvix.Core.Node
diff --git a/src/Juvix/Core/Node.hs b/src/Juvix/Core/Node.hs
index 0618b93022..4ffe90135a 100644
--- a/src/Juvix/Core/Node.hs
+++ b/src/Juvix/Core/Node.hs
@@ -64,13 +64,14 @@ data Node
     Data !Info !Tag ![Node]
   | -- Evaluation only: `LambdaClosure env body`
     LambdaClosure !Info !Env !Node
-  | -- Evaluation only: a suspended term value which cannot be evaluated further,
-    -- e.g., a hole applied to some arguments.
+  | -- Evaluation only: a suspended term value which cannot be evaluated
+    -- further, e.g., a hole applied to some arguments. The suspended term must
+    -- be closed.
     Suspended !Info !Node
 
 -- Other things we might need in the future:
--- - laziness annotations (converting these to closures/thunks should be done
---   further down the pipeline)
+-- - laziness annotations (converting these to closure/thunk creation should be
+--   done further down the pipeline)
 -- - primitive record projections (efficiency of evaluation / generated code)
 -- - Fix and CoFix (anonymous recursion / co-recursion)
 -- - with dependent types, it might actually be more reasonable to have Pi as
@@ -93,7 +94,7 @@ data Constant
 --   equal to the number of implicit binders above `branch`
 data CaseBranch = CaseBranch !Tag !Int !Node
 
--- all nodes in an environment must be closed (no free variables, i.e., de
+-- all nodes in an environment must be closed (no free variables, i.e., no de
 -- Bruijn indices pointing outside the term)
 type Env = [Node]
 
@@ -205,9 +206,10 @@ destruct = \case
       i
       (b : env)
       (1 : map (const 0) env)
-      [fetchBinderInfo i]
+      (fetchBinderInfo i : map (const Nothing) env)
       (\i' args' -> LambdaClosure i' (tl args') (hd args'))
-  Suspended i t -> NodeInfo i [t] [0] [Nothing] (\i' args' -> Suspended i' (hd args'))
+  Suspended i t ->
+    NodeInfo i [t] [0] [Nothing] (\i' args' -> Suspended i' (hd args'))
   where
     fetchBinderInfo :: Info -> Maybe [BinderInfo]
     fetchBinderInfo i = case Info.lookup kBinderInfo i of

From 9d824c2a8d2afd4ac12c06007dcc2df5cde8aa90 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Fri, 29 Jul 2022 09:58:47 +0200
Subject: [PATCH 16/85] comments

---
 src/Juvix/Core/Info.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Juvix/Core/Info.hs b/src/Juvix/Core/Info.hs
index c702d00889..917da99247 100644
--- a/src/Juvix/Core/Info.hs
+++ b/src/Juvix/Core/Info.hs
@@ -1,8 +1,8 @@
 module Juvix.Core.Info where
 
 {-
-  This file defines the type of Info stored in JuvixCore Nodes. The Info data
-  structure maps an info type to an info of that type.
+  This file defines Infos stored in JuvixCore Nodes. The Info data structure
+  maps an info type to an info of that type.
 -}
 
 import Data.Dynamic

From 3297ee648acb5e84f563d4f70619af02b502dba9 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Fri, 29 Jul 2022 16:06:22 +0200
Subject: [PATCH 17/85] refactor

---
 src/Juvix/Core/Context.hs                     |  10 +-
 src/Juvix/Core/Evaluator.hs                   |  10 +-
 src/Juvix/Core/Extra.hs                       | 104 ++++
 src/Juvix/Core/Extra/Base.hs                  | 177 ++++++
 src/Juvix/Core/Extra/Recursors.hs             | 174 ++++++
 src/Juvix/Core/Language.hs                    | 115 ++++
 src/Juvix/Core/{ => Language}/Builtins.hs     |   4 +-
 src/Juvix/Core/{ => Language}/Info.hs         |  26 +-
 .../Core/{ => Language}/Info/BinderInfo.hs    |   8 +-
 .../Core/{ => Language}/Info/FreeVarsInfo.hs  |  10 +-
 .../Core/{ => Language}/Info/IdentInfo.hs     |  10 +-
 .../Core/{ => Language}/Info/LocationInfo.hs  |   4 +-
 .../Core/{ => Language}/Info/NameInfo.hs      |   4 +-
 .../Core/{ => Language}/Info/TypeInfo.hs      |   6 +-
 src/Juvix/Core/Language/Type.hs               |  12 +
 src/Juvix/Core/Node.hs                        | 516 ------------------
 src/Juvix/Core/Prelude.hs                     |  18 +-
 src/Juvix/Core/Type.hs                        |  24 -
 18 files changed, 635 insertions(+), 597 deletions(-)
 create mode 100644 src/Juvix/Core/Extra.hs
 create mode 100644 src/Juvix/Core/Extra/Base.hs
 create mode 100644 src/Juvix/Core/Extra/Recursors.hs
 create mode 100644 src/Juvix/Core/Language.hs
 rename src/Juvix/Core/{ => Language}/Builtins.hs (88%)
 rename src/Juvix/Core/{ => Language}/Info.hs (71%)
 rename src/Juvix/Core/{ => Language}/Info/BinderInfo.hs (71%)
 rename src/Juvix/Core/{ => Language}/Info/FreeVarsInfo.hs (87%)
 rename src/Juvix/Core/{ => Language}/Info/IdentInfo.hs (84%)
 rename src/Juvix/Core/{ => Language}/Info/LocationInfo.hs (68%)
 rename src/Juvix/Core/{ => Language}/Info/NameInfo.hs (66%)
 rename src/Juvix/Core/{ => Language}/Info/TypeInfo.hs (57%)
 create mode 100644 src/Juvix/Core/Language/Type.hs
 delete mode 100644 src/Juvix/Core/Node.hs
 delete mode 100644 src/Juvix/Core/Type.hs

diff --git a/src/Juvix/Core/Context.hs b/src/Juvix/Core/Context.hs
index aa74746ac1..bcbc9fd67f 100644
--- a/src/Juvix/Core/Context.hs
+++ b/src/Juvix/Core/Context.hs
@@ -1,19 +1,13 @@
 module Juvix.Core.Context where
 
-import Juvix.Core.Node
-import Juvix.Core.Prelude
-import Juvix.Core.Type
+import Juvix.Core.Language
+import Juvix.Core.Language.Type
 
 type IdentContext = HashMap Symbol Node
 
 data Context = Context
   { _identContext :: IdentContext,
     _identInfo :: HashMap Symbol IdentInfo,
-    -- We reuse `Name` from Juvix.Syntax.Abstract for runtime-irrelevant
-    -- identifiers (inductive type names, axiom names, etc). We shouldn't do
-    -- this for Symbol and Tag, because we need them "small", consecutive and
-    -- separate for the code generator. Discuss: advantages/disadvantages of
-    -- doing this separation later in the pipeline.
     _inductiveInfo :: HashMap Name InductiveInfo,
     _constructorInfo :: HashMap Tag ConstructorInfo,
     _axiomInfo :: HashMap Name AxiomInfo
diff --git a/src/Juvix/Core/Evaluator.hs b/src/Juvix/Core/Evaluator.hs
index 4b15880953..ff262aafde 100644
--- a/src/Juvix/Core/Evaluator.hs
+++ b/src/Juvix/Core/Evaluator.hs
@@ -2,12 +2,12 @@ module Juvix.Core.Evaluator where
 
 import Data.HashMap.Strict ((!))
 import Juvix.Core.Context
-import Juvix.Core.Info qualified as Info
-import Juvix.Core.Node
-import Juvix.Core.Prelude
+import Juvix.Core.Language.Info qualified as Info
+import Juvix.Core.Language
+import Juvix.Core.Extra
 
 -- `eval ctx env n` evalues a node `n` whose all free variables point into
--- `env`. All nodes in `ctx` and `env` are closed.
+-- `env`. All nodes in `ctx` and `env` are closed and already evaluated.
 eval :: IdentContext -> Env -> Node -> Node
 eval !ctx !env0 = convertRuntimeNodes . eval' env0
   where
@@ -30,7 +30,6 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
       Builtin _ op -> mkBuiltinClosure env op
       Constructor _ tag -> mkConstructorClosure env tag
       ConstValue _ _ -> n
-      Hole _ -> n
       Axiom _ -> n
       App _ l r ->
         -- The semantics for evaluating application (App l r) is:
@@ -75,7 +74,6 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
       Builtin {} -> unimplemented
       ConstValue {} -> evalError
       Data {} -> evalError
-      Hole {} -> Suspended Info.empty (mkApp' n (map (eval' env) args))
       Axiom {} -> Suspended Info.empty (mkApp' n (map (eval' env) args))
       _ -> push env env' (eval' env' n) a args
 
diff --git a/src/Juvix/Core/Extra.hs b/src/Juvix/Core/Extra.hs
new file mode 100644
index 0000000000..6c05ef7396
--- /dev/null
+++ b/src/Juvix/Core/Extra.hs
@@ -0,0 +1,104 @@
+module Juvix.Core.Extra
+  ( module Juvix.Core.Extra,
+    module Juvix.Core.Extra.Base,
+    module Juvix.Core.Extra.Recursors,
+  )
+where
+
+import Data.HashSet qualified as HashSet
+import Juvix.Core.Extra.Base
+import Juvix.Core.Extra.Recursors
+import Juvix.Core.Language
+
+isClosed :: Node -> Bool
+isClosed = ufoldN (&&) go
+  where
+    go :: Index -> Node -> Bool
+    go k = \case
+      Var _ idx | idx >= k -> False
+      _ -> True
+
+getFreeVars :: Node -> HashSet Index
+getFreeVars = gatherN go HashSet.empty
+  where
+    go :: Index -> HashSet Index -> Node -> HashSet Index
+    go k acc = \case
+      Var _ idx | idx >= k -> HashSet.insert (idx - k) acc
+      _ -> acc
+
+getIdents :: Node -> HashSet Symbol
+getIdents = gather go HashSet.empty
+  where
+    go :: HashSet Symbol -> Node -> HashSet Symbol
+    go acc = \case
+      Ident _ sym -> HashSet.insert sym acc
+      _ -> acc
+
+countFreeVarOccurrences :: Index -> Node -> Int
+countFreeVarOccurrences idx = gatherN go 0
+  where
+    go k acc = \case
+      Var _ idx' | idx' == idx + k -> acc + 1
+      _ -> acc
+
+-- increase all free variable indices by a given value
+shift :: Index -> Node -> Node
+shift m = umapN go
+  where
+    go k n = case n of
+      Var i idx | idx >= k -> Var i (idx + m)
+      _ -> n
+
+-- substitute a term t for the free variable with de Bruijn index 0, avoiding
+-- variable capture
+subst :: Node -> Node -> Node
+subst t = umapN go
+  where
+    go k n = case n of
+      Var _ idx | idx == k -> shift k t
+      _ -> n
+
+-- reduce all beta redexes present in a term and the ones created downwards
+-- (i.e., a "beta-development")
+developBeta :: Node -> Node
+developBeta = umap go
+  where
+    go :: Node -> Node
+    go n = case n of
+      App _ (Lambda _ body) arg -> subst arg body
+      _ -> n
+
+-- substitution of all free variables for values in a closed environment
+substEnv :: Env -> Node -> Node
+substEnv env = umapN go
+  where
+    go k n = case n of
+      Var _ idx | idx >= k -> env !! k
+      _ -> n
+
+convertClosures :: Node -> Node
+convertClosures = umap go
+  where
+    go :: Node -> Node
+    go n = case n of
+      LambdaClosure i env b -> substEnv env (Lambda i b)
+      _ -> n
+
+convertData :: Node -> Node
+convertData = umap go
+  where
+    go :: Node -> Node
+    go n = case n of
+      Data i tag args -> mkApp' (Constructor i tag) args
+      _ -> n
+
+convertSuspended :: Node -> Node
+convertSuspended = umap go
+  where
+    go :: Node -> Node
+    go n = case n of
+      Suspended _ t -> t
+      _ -> n
+
+convertRuntimeNodes :: Node -> Node
+convertRuntimeNodes = convertSuspended . convertData . convertClosures
diff --git a/src/Juvix/Core/Extra/Base.hs b/src/Juvix/Core/Extra/Base.hs
new file mode 100644
index 0000000000..f12c571775
--- /dev/null
+++ b/src/Juvix/Core/Extra/Base.hs
@@ -0,0 +1,177 @@
+module Juvix.Core.Extra.Base where
+
+import Data.Functor.Identity
+import Data.List qualified as List
+import Juvix.Core.Language
+import Juvix.Core.Language.Info qualified as Info
+import Juvix.Core.Language.Info.BinderInfo
+import Juvix.Core.Language.Type
+
+{------------------------------------------------------------------------}
+{- functions on Type -}
+
+-- unfold a type into the target and the arguments (left-to-right)
+unfoldType :: Type -> (Type, [Type])
+unfoldType ty = case ty of
+  Fun l r -> let (tgt, args) = unfoldType r in (tgt, l : args)
+  _ -> (ty, [])
+
+getTarget :: Type -> Type
+getTarget = fst . unfoldType
+
+getArgs :: Type -> [Type]
+getArgs = snd . unfoldType
+
+{------------------------------------------------------------------------}
+{- functions on Node -}
+
+mkApp :: Node -> [(Info, Node)] -> Node
+mkApp = foldl' (\acc (i, n) -> App i acc n)
+
+mkApp' :: Node -> [Node] -> Node
+mkApp' = foldl' (App Info.empty)
+
+unfoldApp :: Node -> (Node, [(Info, Node)])
+unfoldApp = go []
+  where
+    go :: [(Info, Node)] -> Node -> (Node, [(Info, Node)])
+    go acc n = case n of
+      App i l r -> go ((i, r) : acc) l
+      _ -> (n, acc)
+
+unfoldLambdas :: Node -> ([Info], Node)
+unfoldLambdas = go []
+  where
+    go :: [Info] -> Node -> ([Info], Node)
+    go acc n = case n of
+      Lambda i b -> go (i : acc) b
+      _ -> (acc, n)
+
+-- `NodeDetails` is a convenience datatype which provides the most commonly needed
+-- information about a node in a generic fashion.
+data NodeDetails = NodeDetails
+  { -- `nodeInfo` is the info associated with the node,
+    _nodeInfo :: Info,
+    -- `nodeChildren` are the children, in a fixed order, i.e., the immediate
+    -- recursive subnodes
+    _nodeChildren :: [Node],
+    -- `nodeChildBindersNum` is the number of binders introduced for each child
+    -- in the parent node. Same length and order as in `nodeChildren`.
+    _nodeChildBindersNum :: [Int],
+    -- `nodeChildBindersInfo` is information about binders for each child, if
+    -- present. Same length and order as in `nodeChildren`.
+    _nodeChildBindersInfo :: [Maybe [BinderInfo]],
+    -- `nodeReassemble` reassembles the node from the info and the children
+    -- (which should be in the same fixed order as in the `nodeChildren`
+    -- component).
+    _nodeReassemble :: Info -> [Node] -> Node
+  }
+
+makeLenses ''NodeDetails
+
+-- destruct a node into NodeDetails
+destruct :: Node -> NodeDetails
+destruct = \case
+  Var i idx -> NodeDetails i [] [] [] (\i' _ -> Var i' idx)
+  Ident i sym -> NodeDetails i [] [] [] (\i' _ -> Ident i' sym)
+  Builtin i op -> NodeDetails i [] [] [] (\i' _ -> Builtin i' op)
+  Constructor i tag -> NodeDetails i [] [] [] (\i' _ -> Constructor i' tag)
+  ConstValue i c -> NodeDetails i [] [] [] (\i' _ -> ConstValue i' c)
+  Axiom i -> NodeDetails i [] [] [] (\i' _ -> Axiom i')
+  App i l r -> NodeDetails i [l, r] [0, 0] [Nothing, Nothing] (\i' args' -> App i' (hd args') (args' !! 1))
+  Lambda i b -> NodeDetails i [b] [1] [fetchBinderInfo i] (\i' args' -> Lambda i' (hd args'))
+  LetIn i v b -> NodeDetails i [v, b] [0, 1] [Nothing, fetchBinderInfo i] (\i' args' -> LetIn i' (hd args') (args' !! 1))
+  Case i v bs Nothing ->
+    NodeDetails
+      i
+      (v : map (\(CaseBranch _ _ br) -> br) bs)
+      (0 : map (\(CaseBranch _ k _) -> k) bs)
+      (Nothing : fetchCaseBinderInfo i (replicate (length bs) Nothing))
+      ( \i' args' ->
+          Case
+            i'
+            (hd args')
+            ( zipWithExact
+                (\(CaseBranch tag k _) br' -> CaseBranch tag k br')
+                bs
+                (tl args')
+            )
+            Nothing
+      )
+  Case i v bs (Just def) ->
+    NodeDetails
+      i
+      (v : def : map (\(CaseBranch _ _ br) -> br) bs)
+      (0 : 0 : map (\(CaseBranch _ k _) -> k) bs)
+      (Nothing : Nothing : fetchCaseBinderInfo i (replicate (length bs) Nothing))
+      ( \i' args' ->
+          Case
+            i'
+            (hd args')
+            ( zipWithExact
+                (\(CaseBranch tag k _) br' -> CaseBranch tag k br')
+                bs
+                (tl (tl args'))
+            )
+            (Just (hd (tl args')))
+      )
+  If i v b1 b2 ->
+    NodeDetails
+      i
+      [v, b1, b2]
+      [0, 0, 0]
+      [Nothing, Nothing, Nothing]
+      (\i' args' -> If i' (hd args') (args' !! 1) (args' !! 2))
+  Data i tag args ->
+    NodeDetails i args (map (const 0) args) (map (const Nothing) args) (`Data` tag)
+  LambdaClosure i env b ->
+    NodeDetails
+      i
+      (b : env)
+      (1 : map (const 0) env)
+      (fetchBinderInfo i : map (const Nothing) env)
+      (\i' args' -> LambdaClosure i' (tl args') (hd args'))
+  Suspended i t ->
+    NodeDetails i [t] [0] [Nothing] (\i' args' -> Suspended i' (hd args'))
+  where
+    fetchBinderInfo :: Info -> Maybe [BinderInfo]
+    fetchBinderInfo i = case Info.lookup kBinderInfo i of
+      Just bi -> Just [bi]
+      Nothing -> Nothing
+
+    fetchCaseBinderInfo :: Info -> [Maybe [BinderInfo]] -> [Maybe [BinderInfo]]
+    fetchCaseBinderInfo i d = case Info.lookup kCaseBinderInfo i of
+      Just cbi -> map Just (cbi ^. infoBranchBinders)
+      Nothing -> d
+
+    hd :: [a] -> a
+    hd = List.head
+
+    tl :: [a] -> [a]
+    tl = List.tail
+
+children :: Node -> [Node]
+children = (^. nodeChildren) . destruct
+
+-- children together with the number of binders
+bchildren :: Node -> [(Int, Node)]
+bchildren n =
+  let ni = destruct n
+   in zipExact (ni ^. nodeChildBindersNum) (ni ^. nodeChildren)
+
+-- shallow children: not under binders
+schildren :: Node -> [Node]
+schildren = map snd . filter (\p -> fst p == 0) . bchildren
+
+getInfo :: Node -> Info
+getInfo = (^. nodeInfo) . destruct
+
+modifyInfoM :: Applicative m => (Info -> m Info) -> Node -> m Node
+modifyInfoM f n =
+  let ni = destruct n
+   in do
+        i' <- f (ni ^. nodeInfo)
+        return ((ni ^. nodeReassemble) i' (ni ^. nodeChildren))
+
+modifyInfo :: (Info -> Info) -> Node -> Node
+modifyInfo f n = runIdentity $ modifyInfoM (pure . f) n
diff --git a/src/Juvix/Core/Extra/Recursors.hs b/src/Juvix/Core/Extra/Recursors.hs
new file mode 100644
index 0000000000..54a9ed74fe
--- /dev/null
+++ b/src/Juvix/Core/Extra/Recursors.hs
@@ -0,0 +1,174 @@
+module Juvix.Core.Extra.Recursors where
+
+import Data.Functor.Identity
+import Juvix.Core.Language
+import Juvix.Core.Language.Info.BinderInfo
+import Juvix.Core.Extra.Base
+
+{---------------------------------------------------------------------------------}
+{- General recursors on Node  -}
+
+-- a collector collects information top-down on a single path in the program
+-- tree
+data Collector a c = Collector
+  { _cEmpty :: c,
+    _cCollect :: a -> c -> c
+  }
+
+makeLenses ''Collector
+
+unitCollector :: Collector a ()
+unitCollector = Collector () (\_ _ -> ())
+
+binderInfoCollector :: Collector (Int, Maybe [BinderInfo]) [Maybe BinderInfo]
+binderInfoCollector =
+  Collector
+    []
+    (\(k, bi) c -> if k == 0 then c else map Just (fromJust bi) ++ c)
+
+binderNumCollector :: Collector (Int, Maybe [BinderInfo]) Index
+binderNumCollector = Collector 0 (\(k, _) c -> c + k)
+
+-- `umapG` maps the nodes bottom-up, i.e., when invoking the mapper function the
+-- recursive subnodes have already been mapped
+umapG ::
+  forall c m.
+  Monad m =>
+  Collector (Int, Maybe [BinderInfo]) c ->
+  (c -> Node -> m Node) ->
+  Node ->
+  m Node
+umapG coll f = go (coll ^. cEmpty)
+  where
+    go :: c -> Node -> m Node
+    go c n =
+      let ni = destruct n
+       in do
+            ns <-
+              sequence $
+                zipWith3Exact
+                  (\n' k bis -> go ((coll ^. cCollect) (k, bis) c) n')
+                  (ni ^. nodeChildren)
+                  (ni ^. nodeChildBindersNum)
+                  (ni ^. nodeChildBindersInfo)
+            f c ((ni ^. nodeReassemble) (ni ^. nodeInfo) ns)
+
+umapM :: Monad m => (Node -> m Node) -> Node -> m Node
+umapM f = umapG unitCollector (const f)
+
+umapMB :: Monad m => ([Maybe BinderInfo] -> Node -> m Node) -> Node -> m Node
+umapMB f = umapG binderInfoCollector f
+
+umapMN :: Monad m => (Index -> Node -> m Node) -> Node -> m Node
+umapMN f = umapG binderNumCollector f
+
+umap :: (Node -> Node) -> Node -> Node
+umap f n = runIdentity $ umapM (return . f) n
+
+umapB :: ([Maybe BinderInfo] -> Node -> Node) -> Node -> Node
+umapB f n = runIdentity $ umapMB (\is -> return . f is) n
+
+umapN :: (Index -> Node -> Node) -> Node -> Node
+umapN f n = runIdentity $ umapMN (\idx -> return . f idx) n
+
+-- `dmapG` maps the nodes top-down
+dmapG ::
+  forall c m.
+  Monad m =>
+  Collector (Int, Maybe [BinderInfo]) c ->
+  (c -> Node -> m Node) ->
+  Node ->
+  m Node
+dmapG coll f = go (coll ^. cEmpty)
+  where
+    go :: c -> Node -> m Node
+    go c n = do
+      n' <- f c n
+      let ni = destruct n'
+      ns <-
+        sequence $
+          zipWith3Exact
+            (\n'' k bis -> go ((coll ^. cCollect) (k, bis) c) n'')
+            (ni ^. nodeChildren)
+            (ni ^. nodeChildBindersNum)
+            (ni ^. nodeChildBindersInfo)
+      return ((ni ^. nodeReassemble) (ni ^. nodeInfo) ns)
+
+dmapM :: Monad m => (Node -> m Node) -> Node -> m Node
+dmapM f = dmapG unitCollector (const f)
+
+dmapMB :: Monad m => ([Maybe BinderInfo] -> Node -> m Node) -> Node -> m Node
+dmapMB f = dmapG binderInfoCollector f
+
+dmapMN :: Monad m => (Index -> Node -> m Node) -> Node -> m Node
+dmapMN f = dmapG binderNumCollector f
+
+dmap :: (Node -> Node) -> Node -> Node
+dmap f n = runIdentity $ dmapM (return . f) n
+
+dmapB :: ([Maybe BinderInfo] -> Node -> Node) -> Node -> Node
+dmapB f n = runIdentity $ dmapMB (\is -> return . f is) n
+
+dmapN :: (Index -> Node -> Node) -> Node -> Node
+dmapN f n = runIdentity $ dmapMN (\idx -> return . f idx) n
+
+-- `ufoldG` folds the tree bottom-up. The `uplus` argument combines the values -
+-- it should be commutative and associative.
+ufoldG ::
+  forall c a m.
+  Monad m =>
+  Collector (Int, Maybe [BinderInfo]) c ->
+  (a -> a -> a) ->
+  (c -> Node -> m a) ->
+  Node ->
+  m a
+ufoldG coll uplus f = go (coll ^. cEmpty)
+  where
+    go :: c -> Node -> m a
+    go c n = foldr (liftM2 uplus) (f c n) mas
+      where
+        ni :: NodeDetails
+        ni = destruct n
+        mas :: [m a]
+        mas =
+          zipWith3Exact
+            (\n' k bis -> go ((coll ^. cCollect) (k, bis) c) n')
+            (ni ^. nodeChildren)
+            (ni ^. nodeChildBindersNum)
+            (ni ^. nodeChildBindersInfo)
+
+ufoldM :: Monad m => (a -> a -> a) -> (Node -> m a) -> Node -> m a
+ufoldM uplus f = ufoldG unitCollector uplus (const f)
+
+ufoldMB :: Monad m => (a -> a -> a) -> ([Maybe BinderInfo] -> Node -> m a) -> Node -> m a
+ufoldMB uplus f = ufoldG binderInfoCollector uplus f
+
+ufoldMN :: Monad m => (a -> a -> a) -> (Index -> Node -> m a) -> Node -> m a
+ufoldMN uplus f = ufoldG binderNumCollector uplus f
+
+ufold :: (a -> a -> a) -> (Node -> a) -> Node -> a
+ufold uplus f n = runIdentity $ ufoldM uplus (return . f) n
+
+ufoldB :: (a -> a -> a) -> ([Maybe BinderInfo] -> Node -> a) -> Node -> a
+ufoldB uplus f n = runIdentity $ ufoldMB uplus (\is -> return . f is) n
+
+ufoldN :: (a -> a -> a) -> (Index -> Node -> a) -> Node -> a
+ufoldN uplus f n = runIdentity $ ufoldMN uplus (\idx -> return . f idx) n
+
+walk :: Monad m => (Node -> m ()) -> Node -> m ()
+walk = ufoldM mappend
+
+walkB :: Monad m => ([Maybe BinderInfo] -> Node -> m ()) -> Node -> m ()
+walkB = ufoldMB mappend
+
+walkN :: Monad m => (Index -> Node -> m ()) -> Node -> m ()
+walkN = ufoldMN mappend
+
+gather :: (a -> Node -> a) -> a -> Node -> a
+gather f acc n = run $ execState acc (walk (\n' -> modify (`f` n')) n)
+
+gatherB :: ([Maybe BinderInfo] -> a -> Node -> a) -> a -> Node -> a
+gatherB f acc n = run $ execState acc (walkB (\is n' -> modify (\a -> f is a n')) n)
+
+gatherN :: (Index -> a -> Node -> a) -> a -> Node -> a
+gatherN f acc n = run $ execState acc (walkN (\idx n' -> modify (\a -> f idx a n')) n)
diff --git a/src/Juvix/Core/Language.hs b/src/Juvix/Core/Language.hs
new file mode 100644
index 0000000000..5d5aea8ad5
--- /dev/null
+++ b/src/Juvix/Core/Language.hs
@@ -0,0 +1,115 @@
+{-# OPTIONS_GHC -Wno-partial-fields #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+{-# HLINT ignore "Avoid restricted flags" #-}
+
+module Juvix.Core.Language (
+  module Juvix.Core.Language,
+  module Juvix.Core.Language.Builtins,
+  module Juvix.Core.Prelude
+) where
+
+{-
+  This file defines the tree representation of JuvixCore (Node datatype) and
+  general recursors on it.
+-}
+
+import Juvix.Core.Language.Builtins
+import Juvix.Core.Prelude
+
+{---------------------------------------------------------------------------------}
+{- Program tree datatype -}
+
+-- Consecutive symbol IDs for reachable user functions.
+type Symbol = Word
+
+-- Tag of a constructor, uniquely identifying it. Tag values are consecutive and
+-- separate from symbol IDs. We might need fixed special tags in Core for common
+-- "builtin" constructors, e.g., unit, nat, lists, pairs, so that the code
+-- generator can treat them specially.
+data Tag = BuiltinTag BuiltinDataTag | UserTag Word
+  deriving stock (Eq)
+
+-- de Bruijn index
+type Index = Int
+
+-- `Node` is the type of nodes in the program tree. The nodes themselves
+-- contain only runtime-relevant information. Runtime-irrelevant annotations
+-- (including all type information) are stored in the infos associated with each
+-- node.
+data Node
+  = -- De Bruijn index of a locally bound variable.
+    Var {varInfo :: !Info, varIndex :: !Index}
+  | -- Global identifier of a function (with corresponding `Node` in the global
+    -- context).
+    Ident {identInfo :: !Info, identSymbol :: !Symbol}
+  | -- A builtin with no corresponding Node, treated specially by the evaluator
+    -- and the code generator. For example, basic arithmetic operations go into
+    -- `Builtin`.
+    Builtin {builtinInfo :: !Info, builtinOp :: !BuiltinOp}
+  | -- A data constructor (the function that creates the data).
+    Constructor {constructorInfo :: !Info, constructorTag :: !Tag}
+  | ConstValue {constantInfo :: !Info, constantValue :: !Constant}
+  | -- An axiom. Computationally a unit.
+    Axiom {axiomInfo :: !Info}
+  | App {appInfo :: !Info, appLeft :: !Node, appRight :: !Node}
+  | Lambda {lambdaInfo :: !Info, lambdaBody :: !Node}
+  | -- `let x := value in body` is not reducible to lambda + application for the purposes
+    -- of ML-polymorphic / dependent type checking or code generation!
+    LetIn {letInfo :: !Info, letValue :: !Node, letBody :: !Node}
+  | -- One-level case matching on the tag of a data constructor: `Case value
+    -- branches default`. `Case` is lazy: only the selected branch is evaluated.
+    Case
+      { caseInfo :: !Info,
+        caseValue :: !Node,
+        caseBranches :: ![CaseBranch],
+        caseDefault :: !(Maybe Node)
+      }
+  | -- Lazy `if` on booleans. It is reasonable to separate booleans from general
+    -- datatypes for the purposes of evaluation and code generation.
+    If
+      { ifInfo :: !Info,
+        ifValue :: !Node,
+        ifTrueBranch :: !Node,
+        ifFalseBranch :: !Node
+      }
+  | -- Evaluation only: evaluated data constructor (the actual data). Arguments
+    -- order: right to left. Arguments are closed values.
+    Data {dataInfo :: !Info, dataTag :: !Tag, dataArgs :: ![Node]}
+  | -- Evaluation only: `LambdaClosure env body`
+    LambdaClosure
+      { closureInfo :: !Info,
+        closureEnv :: !Env,
+        closureBody :: !Node
+      }
+  | -- Evaluation only: a suspended term value which cannot be evaluated
+    -- further, e.g., a hole applied to some arguments. The suspended term must
+    -- be closed.
+    Suspended {suspendedInfo :: !Info, suspendedNode :: !Node}
+
+-- Other things we might need in the future:
+-- - laziness annotations (converting these to closure/thunk creation should be
+--   done further down the pipeline)
+-- - with dependent types, it might actually be more reasonable to have Pi as
+--   another node (because it's a binder); computationally it would be a unit,
+--   erased in further stages of the pipeline
+-- - with Pi a node, other basic type constructors should also be nodes:
+--   TypeIdent (named type identifier available in the global context, e.g.,
+--   inductive type), Universe
+
+data Constant
+  = ConstInteger !Integer
+  | ConstBool !Bool
+
+-- Other things we might need in the future:
+-- - ConstString
+-- - ConstFixedPoint
+
+-- `CaseBranch tag argsNum branch`
+-- - `argsNum` is the number of arguments of the constructor tagged with `tag`,
+--   equal to the number of implicit binders above `branch`
+data CaseBranch = CaseBranch {caseTag :: !Tag, caseBindersNum :: !Int, caseBranch :: !Node}
+
+-- all nodes in an environment must be closed values (no free variables, i.e.,
+-- no de Bruijn indices pointing outside the term)
+type Env = [Node]
diff --git a/src/Juvix/Core/Builtins.hs b/src/Juvix/Core/Language/Builtins.hs
similarity index 88%
rename from src/Juvix/Core/Builtins.hs
rename to src/Juvix/Core/Language/Builtins.hs
index 5361c82c40..c8c1c8b546 100644
--- a/src/Juvix/Core/Builtins.hs
+++ b/src/Juvix/Core/Language/Builtins.hs
@@ -1,4 +1,4 @@
-module Juvix.Core.Builtins where
+module Juvix.Core.Language.Builtins where
 
 import Juvix.Prelude
 
@@ -16,8 +16,6 @@ data BuiltinOp
   | OpIntGe
   | OpBoolAnd
   | OpBoolOr
-  | OpListHead
-  | OpListTail
   | OpPairFst
   | OpPairSnd
   deriving stock (Eq)
diff --git a/src/Juvix/Core/Info.hs b/src/Juvix/Core/Language/Info.hs
similarity index 71%
rename from src/Juvix/Core/Info.hs
rename to src/Juvix/Core/Language/Info.hs
index 917da99247..57bdd2e20f 100644
--- a/src/Juvix/Core/Info.hs
+++ b/src/Juvix/Core/Language/Info.hs
@@ -1,4 +1,4 @@
-module Juvix.Core.Info where
+module Juvix.Core.Language.Info where
 
 {-
   This file defines Infos stored in JuvixCore Nodes. The Info data structure
@@ -9,6 +9,8 @@ import Data.Dynamic
 import Data.HashMap.Strict qualified as HashMap
 import Juvix.Prelude
 
+class Typeable a => IsInfo a
+
 newtype Info = Info
   { _infoMap :: HashMap TypeRep Dynamic
   }
@@ -20,33 +22,33 @@ makeLenses ''Info
 empty :: Info
 empty = Info HashMap.empty
 
-member :: Typeable a => Key a -> Info -> Bool
+member :: IsInfo a => Key a -> Info -> Bool
 member k i = HashMap.member (typeRep k) (i ^. infoMap)
 
-lookup :: Typeable a => Key a -> Info -> Maybe a
+lookup :: IsInfo a => Key a -> Info -> Maybe a
 lookup k i = case HashMap.lookup (typeRep k) (i ^. infoMap) of
   Just a -> fromDyn a impossible
   Nothing -> Nothing
 
-lookupDefault :: Typeable a => a -> Info -> a
+lookupDefault :: IsInfo a => a -> Info -> a
 lookupDefault a i =
   fromDyn (HashMap.lookupDefault (toDyn a) (typeOf a) (i ^. infoMap)) impossible
 
-(!) :: Typeable a => Key a -> Info -> a
-(!) k i = fromJust (Juvix.Core.Info.lookup k i)
+(!) :: IsInfo a => Key a -> Info -> a
+(!) k i = fromJust (Juvix.Core.Language.Info.lookup k i)
 
-insert :: Typeable a => a -> Info -> Info
+insert :: IsInfo a => a -> Info -> Info
 insert a i = Info (HashMap.insert (typeOf a) (toDyn a) (i ^. infoMap))
 
-insertWith :: Typeable a => (a -> a -> a) -> a -> Info -> Info
+insertWith :: IsInfo a => (a -> a -> a) -> a -> Info -> Info
 insertWith f a i = Info (HashMap.insertWith f' (typeOf a) (toDyn a) (i ^. infoMap))
   where
     f' x1 x2 = toDyn (f (fromDyn x1 impossible) (fromDyn x2 impossible))
 
-delete :: Typeable a => Key a -> Info -> Info
+delete :: IsInfo a => Key a -> Info -> Info
 delete k i = Info (HashMap.delete (typeRep k) (i ^. infoMap))
 
-adjust :: forall a. Typeable a => (a -> a) -> Info -> Info
+adjust :: forall a. IsInfo a => (a -> a) -> Info -> Info
 adjust f i =
   Info $
     HashMap.adjust
@@ -54,14 +56,14 @@ adjust f i =
       (typeRep (Proxy :: Proxy a))
       (i ^. infoMap)
 
-update :: forall a. Typeable a => (a -> Maybe a) -> Info -> Info
+update :: forall a. IsInfo a => (a -> Maybe a) -> Info -> Info
 update f i = Info (HashMap.update f' (typeRep (Proxy :: Proxy a)) (i ^. infoMap))
   where
     f' x = case f (fromDyn x impossible) of
       Just y -> Just (toDyn y)
       Nothing -> Nothing
 
-alter :: forall a. Typeable a => (Maybe a -> Maybe a) -> Info -> Info
+alter :: forall a. IsInfo a => (Maybe a -> Maybe a) -> Info -> Info
 alter f i = Info (HashMap.alter f' (typeRep (Proxy :: Proxy a)) (i ^. infoMap))
   where
     f' x = case y of
diff --git a/src/Juvix/Core/Info/BinderInfo.hs b/src/Juvix/Core/Language/Info/BinderInfo.hs
similarity index 71%
rename from src/Juvix/Core/Info/BinderInfo.hs
rename to src/Juvix/Core/Language/Info/BinderInfo.hs
index 3159a4e6ed..daf28e05d9 100644
--- a/src/Juvix/Core/Info/BinderInfo.hs
+++ b/src/Juvix/Core/Language/Info/BinderInfo.hs
@@ -1,13 +1,15 @@
-module Juvix.Core.Info.BinderInfo where
+module Juvix.Core.Language.Info.BinderInfo where
 
 import Juvix.Core.Prelude
-import Juvix.Core.Type
+import Juvix.Core.Language.Type
 
 data BinderInfo = BinderInfo
   { _infoName :: Name,
     _infoType :: Type
   }
 
+instance IsInfo BinderInfo
+
 kBinderInfo :: Key BinderInfo
 kBinderInfo = Proxy
 
@@ -15,6 +17,8 @@ newtype CaseBinderInfo = CaseBinderInfo
   { _infoBranchBinders :: [[BinderInfo]]
   }
 
+instance IsInfo CaseBinderInfo
+
 kCaseBinderInfo :: Key CaseBinderInfo
 kCaseBinderInfo = Proxy
 
diff --git a/src/Juvix/Core/Info/FreeVarsInfo.hs b/src/Juvix/Core/Language/Info/FreeVarsInfo.hs
similarity index 87%
rename from src/Juvix/Core/Info/FreeVarsInfo.hs
rename to src/Juvix/Core/Language/Info/FreeVarsInfo.hs
index aa84138547..30ad9eaebd 100644
--- a/src/Juvix/Core/Info/FreeVarsInfo.hs
+++ b/src/Juvix/Core/Language/Info/FreeVarsInfo.hs
@@ -1,15 +1,17 @@
-module Juvix.Core.Info.FreeVarsInfo where
+module Juvix.Core.Language.Info.FreeVarsInfo where
 
 import Data.HashMap.Strict qualified as HashMap
-import Juvix.Core.Info qualified as Info
-import Juvix.Core.Node
-import Juvix.Core.Prelude
+import Juvix.Core.Language.Info qualified as Info
+import Juvix.Core.Language
+import Juvix.Core.Extra
 
 newtype FreeVarsInfo = FreeVarsInfo
   { -- map free variables to the number of their occurrences
     _infoFreeVars :: HashMap Index Int
   }
 
+instance IsInfo FreeVarsInfo
+
 kFreeVarsInfo :: Key FreeVarsInfo
 kFreeVarsInfo = Proxy
 
diff --git a/src/Juvix/Core/Info/IdentInfo.hs b/src/Juvix/Core/Language/Info/IdentInfo.hs
similarity index 84%
rename from src/Juvix/Core/Info/IdentInfo.hs
rename to src/Juvix/Core/Language/Info/IdentInfo.hs
index 4b893300f4..69ae26e4a7 100644
--- a/src/Juvix/Core/Info/IdentInfo.hs
+++ b/src/Juvix/Core/Language/Info/IdentInfo.hs
@@ -1,15 +1,17 @@
-module Juvix.Core.Info.IdentInfo where
+module Juvix.Core.Language.Info.IdentInfo where
 
 import Data.HashMap.Strict qualified as HashMap
-import Juvix.Core.Info qualified as Info
-import Juvix.Core.Node
-import Juvix.Core.Prelude
+import Juvix.Core.Language.Info qualified as Info
+import Juvix.Core.Language
+import Juvix.Core.Extra
 
 newtype IdentInfo = IdentInfo
   { -- map symbols to the number of their occurrences
     _infoIdents :: HashMap Symbol Int
   }
 
+instance IsInfo IdentInfo
+
 kIdentInfo :: Key IdentInfo
 kIdentInfo = Proxy
 
diff --git a/src/Juvix/Core/Info/LocationInfo.hs b/src/Juvix/Core/Language/Info/LocationInfo.hs
similarity index 68%
rename from src/Juvix/Core/Info/LocationInfo.hs
rename to src/Juvix/Core/Language/Info/LocationInfo.hs
index 741e460cfe..1cec57d8da 100644
--- a/src/Juvix/Core/Info/LocationInfo.hs
+++ b/src/Juvix/Core/Language/Info/LocationInfo.hs
@@ -1,9 +1,11 @@
-module Juvix.Core.Info.LocationInfo where
+module Juvix.Core.Language.Info.LocationInfo where
 
 import Juvix.Core.Prelude
 
 newtype LocationInfo = LocationInfo {_infoLocation :: Location}
 
+instance IsInfo LocationInfo
+
 kLocationInfo :: Key LocationInfo
 kLocationInfo = Proxy
 
diff --git a/src/Juvix/Core/Info/NameInfo.hs b/src/Juvix/Core/Language/Info/NameInfo.hs
similarity index 66%
rename from src/Juvix/Core/Info/NameInfo.hs
rename to src/Juvix/Core/Language/Info/NameInfo.hs
index a33be004d3..af38ba333f 100644
--- a/src/Juvix/Core/Info/NameInfo.hs
+++ b/src/Juvix/Core/Language/Info/NameInfo.hs
@@ -1,9 +1,11 @@
-module Juvix.Core.Info.NameInfo where
+module Juvix.Core.Language.Info.NameInfo where
 
 import Juvix.Core.Prelude
 
 newtype NameInfo = NameInfo {_infoName :: Name}
 
+instance IsInfo NameInfo
+
 kNameInfo :: Key NameInfo
 kNameInfo = Proxy
 
diff --git a/src/Juvix/Core/Info/TypeInfo.hs b/src/Juvix/Core/Language/Info/TypeInfo.hs
similarity index 57%
rename from src/Juvix/Core/Info/TypeInfo.hs
rename to src/Juvix/Core/Language/Info/TypeInfo.hs
index 1660e1f689..4247090963 100644
--- a/src/Juvix/Core/Info/TypeInfo.hs
+++ b/src/Juvix/Core/Language/Info/TypeInfo.hs
@@ -1,10 +1,12 @@
-module Juvix.Core.Info.TypeInfo where
+module Juvix.Core.Language.Info.TypeInfo where
 
 import Juvix.Core.Prelude
-import Juvix.Core.Type
+import Juvix.Core.Language.Type
 
 newtype TypeInfo = TypeInfo {_infoType :: Type}
 
+instance IsInfo TypeInfo
+
 kTypeInfo :: Key TypeInfo
 kTypeInfo = Proxy
 
diff --git a/src/Juvix/Core/Language/Type.hs b/src/Juvix/Core/Language/Type.hs
new file mode 100644
index 0000000000..c944428ddf
--- /dev/null
+++ b/src/Juvix/Core/Language/Type.hs
@@ -0,0 +1,12 @@
+module Juvix.Core.Language.Type where
+
+import Juvix.Core.Prelude
+
+data Type = Atomic Atom | Fun Type Type | Universe
+
+data Atom = Atom
+  { _atomHead :: Name,
+    _atomArgs :: [Type]
+  }
+
+makeLenses ''Atom
diff --git a/src/Juvix/Core/Node.hs b/src/Juvix/Core/Node.hs
deleted file mode 100644
index 4ffe90135a..0000000000
--- a/src/Juvix/Core/Node.hs
+++ /dev/null
@@ -1,516 +0,0 @@
-module Juvix.Core.Node where
-
-{-
-  This file defines the tree representation of JuvixCore (Node datatype) and
-  general recursors on it.
--}
-
-import Data.Functor.Identity
-import Data.HashSet qualified as HashSet
-import Juvix.Core.Info qualified as Info
-import Juvix.Core.Info.BinderInfo
-import Juvix.Core.Prelude
-
-{---------------------------------------------------------------------------------}
-{- Program tree datatype -}
-
--- Consecutive symbol IDs for reachable user functions.
-type Symbol = Word
-
--- Tag of a constructor, uniquely identifying it. Tag values are consecutive and
--- separate from symbol IDs. We might need fixed special tags in Core for common
--- "builtin" constructors, e.g., unit, nat, lists, pairs, so that the code
--- generator can treat them specially.
-data Tag = BuiltinTag BuiltinDataTag | UserTag Word
-  deriving stock (Eq)
-
--- de Bruijn index
-type Index = Int
-
--- `Node` is the type of nodes in the program tree. The nodes themselves
--- contain only runtime-relevant information. Runtime-irrelevant annotations
--- (including all type information) are stored in the infos associated with each
--- node.
-data Node
-  = -- De Bruijn index of a locally lambda-bound variable.
-    Var !Info !Index
-  | -- Global identifier of a function (with corresponding `Node` in the global
-    -- context).
-    Ident !Info !Symbol
-  | -- A builtin with no corresponding Node, treated specially by the evaluator
-    -- and the code generator. For example, basic arithmetic operations go into
-    -- `Builtin`.
-    Builtin !Info !BuiltinOp
-  | -- A data constructor (the function that creates the data).
-    Constructor !Info !Tag
-  | ConstValue !Info !Constant
-  | -- A hole. It's a unit for the purposes of evaluation.
-    Hole !Info
-  | -- An axiom. Computationally a unit.
-    Axiom !Info
-  | App !Info !Node !Node
-  | Lambda !Info !Node
-  | -- `let x := value in body` is not reducible to lambda + application for the purposes
-    -- of ML-polymorphic / dependent type checking or code generation!
-    LetIn !Info !Node !Node
-  | -- One-level case matching on the tag of a data constructor: `Case value
-    -- branches default`. `Case` is lazy: only the selected branch is evaluated.
-    Case !Info !Node ![CaseBranch] !(Maybe Node)
-  | -- Lazy `if` on booleans. It is reasonable to separate booleans from general
-    -- datatypes for the purposes of evaluation and code generation.
-    If !Info !Node !Node !Node
-  | -- Evaluation only: evaluated data constructor (the actual data). Arguments
-    -- order: right to left.
-    Data !Info !Tag ![Node]
-  | -- Evaluation only: `LambdaClosure env body`
-    LambdaClosure !Info !Env !Node
-  | -- Evaluation only: a suspended term value which cannot be evaluated
-    -- further, e.g., a hole applied to some arguments. The suspended term must
-    -- be closed.
-    Suspended !Info !Node
-
--- Other things we might need in the future:
--- - laziness annotations (converting these to closure/thunk creation should be
---   done further down the pipeline)
--- - primitive record projections (efficiency of evaluation / generated code)
--- - Fix and CoFix (anonymous recursion / co-recursion)
--- - with dependent types, it might actually be more reasonable to have Pi as
---   another node (because it's a binder); computationally it would be a unit,
---   erased in further stages of the pipeline
--- - with Pi a node, other basic type constructors should also be nodes:
---   TypeIdent (named type identifier available in the global context, e.g.,
---   inductive type), Universe
-
-data Constant
-  = ConstInteger !Integer
-  | ConstBool !Bool
-
--- Other things we might need in the future:
--- - ConstFloat
--- - ConstString
-
--- `CaseBranch tag argsNum branch`
--- - `argsNum` is the number of arguments of the constructor tagged with `tag`,
---   equal to the number of implicit binders above `branch`
-data CaseBranch = CaseBranch !Tag !Int !Node
-
--- all nodes in an environment must be closed (no free variables, i.e., no de
--- Bruijn indices pointing outside the term)
-type Env = [Node]
-
-{---------------------------------------------------------------------------------}
-{- simple helper functions -}
-
-mkApp :: Node -> [(Info, Node)] -> Node
-mkApp = foldl' (\acc (i, n) -> App i acc n)
-
-mkApp' :: Node -> [Node] -> Node
-mkApp' = foldl' (App Info.empty)
-
-unfoldApp :: Node -> (Node, [(Info, Node)])
-unfoldApp = go []
-  where
-    go :: [(Info, Node)] -> Node -> (Node, [(Info, Node)])
-    go acc n = case n of
-      App i l r -> go ((i, r) : acc) l
-      _ -> (n, acc)
-
-unfoldLambdas :: Node -> ([Info], Node)
-unfoldLambdas = go []
-  where
-    go :: [Info] -> Node -> ([Info], Node)
-    go acc n = case n of
-      Lambda i b -> go (i : acc) b
-      _ -> (acc, n)
-
--- `NodeInfo` is a convenience datatype which provides the most commonly needed
--- information about a node in a generic fashion.
-data NodeInfo = NodeInfo
-  { -- `nodeInfo` is the info associated with the node,
-    _nodeInfo :: Info,
-    -- `nodeChildren` are the children, in a fixed order, i.e., the immediate
-    -- recursive occurrences of Node
-    _nodeChildren :: [Node],
-    -- `nodeChildBindersNum` is the number of binders introduced for each child
-    -- in the parent node. Same length and order as in `nodeChildren`.
-    _nodeChildBindersNum :: [Int],
-    -- `nodeChildBindersInfo` is information about binders for each child, if
-    -- present. Same length and order as in `nodeChildren`.
-    _nodeChildBindersInfo :: [Maybe [BinderInfo]],
-    -- `nodeReassemble` reassembles the node from the info and the children
-    -- (which should be in the same fixed order as in the `nodeChildren`
-    -- component).
-    _nodeReassemble :: Info -> [Node] -> Node
-  }
-
-makeLenses ''NodeInfo
-
--- destruct a node into NodeInfo
-destruct :: Node -> NodeInfo
-destruct = \case
-  Var i idx -> NodeInfo i [] [] [] (\i' _ -> Var i' idx)
-  Ident i sym -> NodeInfo i [] [] [] (\i' _ -> Ident i' sym)
-  Builtin i op -> NodeInfo i [] [] [] (\i' _ -> Builtin i' op)
-  Constructor i tag -> NodeInfo i [] [] [] (\i' _ -> Constructor i' tag)
-  ConstValue i c -> NodeInfo i [] [] [] (\i' _ -> ConstValue i' c)
-  Hole i -> NodeInfo i [] [] [] (\i' _ -> Hole i')
-  Axiom i -> NodeInfo i [] [] [] (\i' _ -> Axiom i')
-  App i l r -> NodeInfo i [l, r] [0, 0] [Nothing, Nothing] (\i' args' -> App i' (hd args') (args' !! 1))
-  Lambda i b -> NodeInfo i [b] [1] [fetchBinderInfo i] (\i' args' -> Lambda i' (hd args'))
-  LetIn i v b -> NodeInfo i [v, b] [0, 1] [Nothing, fetchBinderInfo i] (\i' args' -> LetIn i' (hd args') (args' !! 1))
-  Case i v bs Nothing ->
-    NodeInfo
-      i
-      (v : map (\(CaseBranch _ _ br) -> br) bs)
-      (0 : map (\(CaseBranch _ k _) -> k) bs)
-      (Nothing : fetchCaseBinderInfo i (replicate (length bs) Nothing))
-      ( \i' args' ->
-          Case
-            i'
-            (hd args')
-            ( zipWithExact
-                (\(CaseBranch tag k _) br' -> CaseBranch tag k br')
-                bs
-                (tl args')
-            )
-            Nothing
-      )
-  Case i v bs (Just def) ->
-    NodeInfo
-      i
-      (v : def : map (\(CaseBranch _ _ br) -> br) bs)
-      (0 : 0 : map (\(CaseBranch _ k _) -> k) bs)
-      (Nothing : Nothing : fetchCaseBinderInfo i (replicate (length bs) Nothing))
-      ( \i' args' ->
-          Case
-            i'
-            (hd args')
-            ( zipWithExact
-                (\(CaseBranch tag k _) br' -> CaseBranch tag k br')
-                bs
-                (tl (tl args'))
-            )
-            (Just (hd (tl args')))
-      )
-  If i v b1 b2 ->
-    NodeInfo
-      i
-      [v, b1, b2]
-      [0, 0, 0]
-      [Nothing, Nothing, Nothing]
-      (\i' args' -> If i' (hd args') (args' !! 1) (args' !! 2))
-  Data i tag args ->
-    NodeInfo i args (map (const 0) args) (map (const Nothing) args) (`Data` tag)
-  LambdaClosure i env b ->
-    NodeInfo
-      i
-      (b : env)
-      (1 : map (const 0) env)
-      (fetchBinderInfo i : map (const Nothing) env)
-      (\i' args' -> LambdaClosure i' (tl args') (hd args'))
-  Suspended i t ->
-    NodeInfo i [t] [0] [Nothing] (\i' args' -> Suspended i' (hd args'))
-  where
-    fetchBinderInfo :: Info -> Maybe [BinderInfo]
-    fetchBinderInfo i = case Info.lookup kBinderInfo i of
-      Just bi -> Just [bi]
-      Nothing -> Nothing
-
-    fetchCaseBinderInfo :: Info -> [Maybe [BinderInfo]] -> [Maybe [BinderInfo]]
-    fetchCaseBinderInfo i d = case Info.lookup kCaseBinderInfo i of
-      Just cbi -> map Just (cbi ^. infoBranchBinders)
-      Nothing -> d
-
-children :: Node -> [Node]
-children = (^. nodeChildren) . destruct
-
--- children together with the number of binders
-bchildren :: Node -> [(Int, Node)]
-bchildren n =
-  let ni = destruct n
-   in zipExact (ni ^. nodeChildBindersNum) (ni ^. nodeChildren)
-
--- shallow children: not under binders
-schildren :: Node -> [Node]
-schildren = map snd . filter (\p -> fst p == 0) . bchildren
-
-getInfo :: Node -> Info
-getInfo = (^. nodeInfo) . destruct
-
-modifyInfoM :: Applicative m => (Info -> m Info) -> Node -> m Node
-modifyInfoM f n =
-  let ni = destruct n
-   in do
-        i' <- f (ni ^. nodeInfo)
-        return ((ni ^. nodeReassemble) i' (ni ^. nodeChildren))
-
-modifyInfo :: (Info -> Info) -> Node -> Node
-modifyInfo f n = runIdentity $ modifyInfoM (pure . f) n
-
-{---------------------------------------------------------------------------------}
-{- General recursors on Node  -}
-
--- Note: In the (distant) future, with dependent types, the type information
--- will contain Nodes. Then mapping/folding needs to be performed also on the
--- Nodes stored as type information.
-
--- a collector collects information top-down on a single path in the program
--- tree
-data Collector a c = Collector
-  { _cEmpty :: c,
-    _cCollect :: a -> c -> c
-  }
-
-makeLenses ''Collector
-
-unitCollector :: Collector a ()
-unitCollector = Collector () (\_ _ -> ())
-
-binderInfoCollector :: Collector (Int, Maybe [BinderInfo]) [Maybe BinderInfo]
-binderInfoCollector =
-  Collector
-    []
-    (\(k, bi) c -> if k == 0 then c else map Just (fromJust bi) ++ c)
-
-binderNumCollector :: Collector (Int, Maybe [BinderInfo]) Index
-binderNumCollector = Collector 0 (\(k, _) c -> c + k)
-
--- `umapG` maps the nodes bottom-up, i.e., when invoking the mapper function the
--- recursive subnodes have already been mapped
-umapG ::
-  forall c m.
-  Monad m =>
-  Collector (Int, Maybe [BinderInfo]) c ->
-  (c -> Node -> m Node) ->
-  Node ->
-  m Node
-umapG coll f = go (coll ^. cEmpty)
-  where
-    go :: c -> Node -> m Node
-    go c n =
-      let ni = destruct n
-       in do
-            ns <-
-              sequence $
-                zipWith3Exact
-                  (\n' k bis -> go ((coll ^. cCollect) (k, bis) c) n')
-                  (ni ^. nodeChildren)
-                  (ni ^. nodeChildBindersNum)
-                  (ni ^. nodeChildBindersInfo)
-            f c ((ni ^. nodeReassemble) (ni ^. nodeInfo) ns)
-
-umapM :: Monad m => (Node -> m Node) -> Node -> m Node
-umapM f = umapG unitCollector (const f)
-
-umapMB :: Monad m => ([Maybe BinderInfo] -> Node -> m Node) -> Node -> m Node
-umapMB f = umapG binderInfoCollector f
-
-umapMN :: Monad m => (Index -> Node -> m Node) -> Node -> m Node
-umapMN f = umapG binderNumCollector f
-
-umap :: (Node -> Node) -> Node -> Node
-umap f n = runIdentity $ umapM (return . f) n
-
-umapB :: ([Maybe BinderInfo] -> Node -> Node) -> Node -> Node
-umapB f n = runIdentity $ umapMB (\is -> return . f is) n
-
-umapN :: (Index -> Node -> Node) -> Node -> Node
-umapN f n = runIdentity $ umapMN (\idx -> return . f idx) n
-
--- `dmapG` maps the nodes top-down
-dmapG ::
-  forall c m.
-  Monad m =>
-  Collector (Int, Maybe [BinderInfo]) c ->
-  (c -> Node -> m Node) ->
-  Node ->
-  m Node
-dmapG coll f = go (coll ^. cEmpty)
-  where
-    go :: c -> Node -> m Node
-    go c n = do
-      n' <- f c n
-      let ni = destruct n'
-      ns <-
-        sequence $
-          zipWith3Exact
-            (\n'' k bis -> go ((coll ^. cCollect) (k, bis) c) n'')
-            (ni ^. nodeChildren)
-            (ni ^. nodeChildBindersNum)
-            (ni ^. nodeChildBindersInfo)
-      return ((ni ^. nodeReassemble) (ni ^. nodeInfo) ns)
-
-dmapM :: Monad m => (Node -> m Node) -> Node -> m Node
-dmapM f = dmapG unitCollector (const f)
-
-dmapMB :: Monad m => ([Maybe BinderInfo] -> Node -> m Node) -> Node -> m Node
-dmapMB f = dmapG binderInfoCollector f
-
-dmapMN :: Monad m => (Index -> Node -> m Node) -> Node -> m Node
-dmapMN f = dmapG binderNumCollector f
-
-dmap :: (Node -> Node) -> Node -> Node
-dmap f n = runIdentity $ dmapM (return . f) n
-
-dmapB :: ([Maybe BinderInfo] -> Node -> Node) -> Node -> Node
-dmapB f n = runIdentity $ dmapMB (\is -> return . f is) n
-
-dmapN :: (Index -> Node -> Node) -> Node -> Node
-dmapN f n = runIdentity $ dmapMN (\idx -> return . f idx) n
-
--- `ufoldG` folds the tree bottom-up. The `uplus` argument combines the values -
--- it should be commutative and associative.
-ufoldG ::
-  forall c a m.
-  Monad m =>
-  Collector (Int, Maybe [BinderInfo]) c ->
-  (a -> a -> a) ->
-  (c -> Node -> m a) ->
-  Node ->
-  m a
-ufoldG coll uplus f = go (coll ^. cEmpty)
-  where
-    go :: c -> Node -> m a
-    go c n = foldr (liftM2 uplus) (f c n) mas
-      where
-        ni :: NodeInfo
-        ni = destruct n
-        mas :: [m a]
-        mas =
-          zipWith3Exact
-            (\n' k bis -> go ((coll ^. cCollect) (k, bis) c) n')
-            (ni ^. nodeChildren)
-            (ni ^. nodeChildBindersNum)
-            (ni ^. nodeChildBindersInfo)
-
-ufoldM :: Monad m => (a -> a -> a) -> (Node -> m a) -> Node -> m a
-ufoldM uplus f = ufoldG unitCollector uplus (const f)
-
-ufoldMB :: Monad m => (a -> a -> a) -> ([Maybe BinderInfo] -> Node -> m a) -> Node -> m a
-ufoldMB uplus f = ufoldG binderInfoCollector uplus f
-
-ufoldMN :: Monad m => (a -> a -> a) -> (Index -> Node -> m a) -> Node -> m a
-ufoldMN uplus f = ufoldG binderNumCollector uplus f
-
-ufold :: (a -> a -> a) -> (Node -> a) -> Node -> a
-ufold uplus f n = runIdentity $ ufoldM uplus (return . f) n
-
-ufoldB :: (a -> a -> a) -> ([Maybe BinderInfo] -> Node -> a) -> Node -> a
-ufoldB uplus f n = runIdentity $ ufoldMB uplus (\is -> return . f is) n
-
-ufoldN :: (a -> a -> a) -> (Index -> Node -> a) -> Node -> a
-ufoldN uplus f n = runIdentity $ ufoldMN uplus (\idx -> return . f idx) n
-
-walk :: Monad m => (Node -> m ()) -> Node -> m ()
-walk = ufoldM mappend
-
-walkB :: Monad m => ([Maybe BinderInfo] -> Node -> m ()) -> Node -> m ()
-walkB = ufoldMB mappend
-
-walkN :: Monad m => (Index -> Node -> m ()) -> Node -> m ()
-walkN = ufoldMN mappend
-
-gather :: (a -> Node -> a) -> a -> Node -> a
-gather f acc n = fst $ run $ runState acc (walk (\n' -> modify (`f` n')) n)
-
-gatherB :: ([Maybe BinderInfo] -> a -> Node -> a) -> a -> Node -> a
-gatherB f acc n = fst $ run $ runState acc (walkB (\is n' -> modify (\a -> f is a n')) n)
-
-gatherN :: (Index -> a -> Node -> a) -> a -> Node -> a
-gatherN f acc n = fst $ run $ runState acc (walkN (\idx n' -> modify (\a -> f idx a n')) n)
-
-{---------------------------------------------------------------------------}
-{- useful functions implemented using general recursors -}
-
-isClosed :: Node -> Bool
-isClosed = ufoldN (&&) go
-  where
-    go :: Index -> Node -> Bool
-    go k = \case
-      Var _ idx | idx >= k -> False
-      _ -> True
-
-getFreeVars :: Node -> HashSet Index
-getFreeVars = gatherN go HashSet.empty
-  where
-    go :: Index -> HashSet Index -> Node -> HashSet Index
-    go k acc = \case
-      Var _ idx | idx >= k -> HashSet.insert (idx - k) acc
-      _ -> acc
-
-getIdents :: Node -> HashSet Symbol
-getIdents = gather go HashSet.empty
-  where
-    go :: HashSet Symbol -> Node -> HashSet Symbol
-    go acc = \case
-      Ident _ sym -> HashSet.insert sym acc
-      _ -> acc
-
-countFreeVarOccurrences :: Index -> Node -> Int
-countFreeVarOccurrences idx = gatherN go 0
-  where
-    go k acc = \case
-      Var _ idx' | idx' == idx + k -> acc + 1
-      _ -> acc
-
--- increase all free variable indices by a given value
-shift :: Index -> Node -> Node
-shift m = umapN go
-  where
-    go k n = case n of
-      Var i idx | idx >= k -> Var i (idx + m)
-      _ -> n
-
--- substitute a term t for the free variable with de Bruijn index 0, avoiding
--- variable capture
-subst :: Node -> Node -> Node
-subst t = umapN go
-  where
-    go k n = case n of
-      Var _ idx | idx == k -> shift k t
-      _ -> n
-
--- reduce all beta redexes present in a term and the ones created upwards
--- (i.e., a "beta-development")
-reduceBeta :: Node -> Node
-reduceBeta = umap go
-  where
-    go :: Node -> Node
-    go n = case n of
-      App _ (Lambda _ body) arg -> subst arg body
-      _ -> n
-
--- substitution of all free variables for values in a closed environment
-substEnv :: Env -> Node -> Node
-substEnv env = umapN go
-  where
-    go k n = case n of
-      Var _ idx | idx >= k -> env !! k
-      _ -> n
-
-convertClosures :: Node -> Node
-convertClosures = umap go
-  where
-    go :: Node -> Node
-    go n = case n of
-      LambdaClosure i env b -> substEnv env (Lambda i b)
-      _ -> n
-
-convertData :: Node -> Node
-convertData = umap go
-  where
-    go :: Node -> Node
-    go n = case n of
-      Data i tag args -> mkApp' (Constructor i tag) args
-      _ -> n
-
-convertSuspended :: Node -> Node
-convertSuspended = umap go
-  where
-    go :: Node -> Node
-    go n = case n of
-      Suspended _ t -> t
-      _ -> n
-
-convertRuntimeNodes :: Node -> Node
-convertRuntimeNodes = convertSuspended . convertData . convertClosures
diff --git a/src/Juvix/Core/Prelude.hs b/src/Juvix/Core/Prelude.hs
index 0401ecad79..2a88645ffe 100644
--- a/src/Juvix/Core/Prelude.hs
+++ b/src/Juvix/Core/Prelude.hs
@@ -1,27 +1,17 @@
 module Juvix.Core.Prelude
-  ( module Juvix.Core.Builtins,
-    Info,
+  ( Info,
     Key,
+    IsInfo,
     module Juvix.Prelude,
     module Juvix.Prelude.Loc,
     module Juvix.Syntax.Abstract.Name,
-    Location,
-    hd,
-    tl,
+    Location
   )
 where
 
-import Data.List qualified as List
-import Juvix.Core.Builtins
-import Juvix.Core.Info (Info, Key)
+import Juvix.Core.Language.Info (Info, Key, IsInfo)
 import Juvix.Prelude
 import Juvix.Prelude.Loc
 import Juvix.Syntax.Abstract.Name
 
 type Location = Interval
-
-hd :: [a] -> a
-hd = List.head
-
-tl :: [a] -> [a]
-tl = List.tail
diff --git a/src/Juvix/Core/Type.hs b/src/Juvix/Core/Type.hs
deleted file mode 100644
index 350576cc40..0000000000
--- a/src/Juvix/Core/Type.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-module Juvix.Core.Type where
-
-import Juvix.Core.Prelude
-
-data Type = Atomic Atom | Fun Type Type | Universe
-
-data Atom = Atom
-  { _atomHead :: Name,
-    _atomArgs :: [Type]
-  }
-
-makeLenses ''Atom
-
--- unfold a type into the target and the arguments (left-to-right)
-unfoldType :: Type -> (Type, [Type])
-unfoldType ty = case ty of
-  Fun l r -> let (tgt, args) = unfoldType r in (tgt, l : args)
-  _ -> (ty, [])
-
-getTarget :: Type -> Type
-getTarget = fst . unfoldType
-
-getArgs :: Type -> [Type]
-getArgs = snd . unfoldType

From 427b4a505e3aed1e8c36c441868b848e0cb5752b Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Fri, 29 Jul 2022 16:13:57 +0200
Subject: [PATCH 18/85] refactor

---
 src/Juvix/Core/Language.hs                      | 4 ++--
 src/Juvix/Core/{Prelude.hs => Language/Base.hs} | 2 +-
 src/Juvix/Core/Language/Info/BinderInfo.hs      | 2 +-
 src/Juvix/Core/Language/Info/LocationInfo.hs    | 2 +-
 src/Juvix/Core/Language/Info/NameInfo.hs        | 2 +-
 src/Juvix/Core/Language/Info/TypeInfo.hs        | 2 +-
 6 files changed, 7 insertions(+), 7 deletions(-)
 rename src/Juvix/Core/{Prelude.hs => Language/Base.hs} (90%)

diff --git a/src/Juvix/Core/Language.hs b/src/Juvix/Core/Language.hs
index 5d5aea8ad5..4e159fd28a 100644
--- a/src/Juvix/Core/Language.hs
+++ b/src/Juvix/Core/Language.hs
@@ -6,7 +6,7 @@
 module Juvix.Core.Language (
   module Juvix.Core.Language,
   module Juvix.Core.Language.Builtins,
-  module Juvix.Core.Prelude
+  module Juvix.Core.Language.Base
 ) where
 
 {-
@@ -15,7 +15,7 @@ module Juvix.Core.Language (
 -}
 
 import Juvix.Core.Language.Builtins
-import Juvix.Core.Prelude
+import Juvix.Core.Language.Base
 
 {---------------------------------------------------------------------------------}
 {- Program tree datatype -}
diff --git a/src/Juvix/Core/Prelude.hs b/src/Juvix/Core/Language/Base.hs
similarity index 90%
rename from src/Juvix/Core/Prelude.hs
rename to src/Juvix/Core/Language/Base.hs
index 2a88645ffe..42424eb7d4 100644
--- a/src/Juvix/Core/Prelude.hs
+++ b/src/Juvix/Core/Language/Base.hs
@@ -1,4 +1,4 @@
-module Juvix.Core.Prelude
+module Juvix.Core.Language.Base
   ( Info,
     Key,
     IsInfo,
diff --git a/src/Juvix/Core/Language/Info/BinderInfo.hs b/src/Juvix/Core/Language/Info/BinderInfo.hs
index daf28e05d9..546b288850 100644
--- a/src/Juvix/Core/Language/Info/BinderInfo.hs
+++ b/src/Juvix/Core/Language/Info/BinderInfo.hs
@@ -1,6 +1,6 @@
 module Juvix.Core.Language.Info.BinderInfo where
 
-import Juvix.Core.Prelude
+import Juvix.Core.Language.Base
 import Juvix.Core.Language.Type
 
 data BinderInfo = BinderInfo
diff --git a/src/Juvix/Core/Language/Info/LocationInfo.hs b/src/Juvix/Core/Language/Info/LocationInfo.hs
index 1cec57d8da..1a48b4616a 100644
--- a/src/Juvix/Core/Language/Info/LocationInfo.hs
+++ b/src/Juvix/Core/Language/Info/LocationInfo.hs
@@ -1,6 +1,6 @@
 module Juvix.Core.Language.Info.LocationInfo where
 
-import Juvix.Core.Prelude
+import Juvix.Core.Language.Base
 
 newtype LocationInfo = LocationInfo {_infoLocation :: Location}
 
diff --git a/src/Juvix/Core/Language/Info/NameInfo.hs b/src/Juvix/Core/Language/Info/NameInfo.hs
index af38ba333f..ad07d56ac5 100644
--- a/src/Juvix/Core/Language/Info/NameInfo.hs
+++ b/src/Juvix/Core/Language/Info/NameInfo.hs
@@ -1,6 +1,6 @@
 module Juvix.Core.Language.Info.NameInfo where
 
-import Juvix.Core.Prelude
+import Juvix.Core.Language.Base
 
 newtype NameInfo = NameInfo {_infoName :: Name}
 
diff --git a/src/Juvix/Core/Language/Info/TypeInfo.hs b/src/Juvix/Core/Language/Info/TypeInfo.hs
index 4247090963..3006c4ffb5 100644
--- a/src/Juvix/Core/Language/Info/TypeInfo.hs
+++ b/src/Juvix/Core/Language/Info/TypeInfo.hs
@@ -1,6 +1,6 @@
 module Juvix.Core.Language.Info.TypeInfo where
 
-import Juvix.Core.Prelude
+import Juvix.Core.Language.Base
 import Juvix.Core.Language.Type
 
 newtype TypeInfo = TypeInfo {_infoType :: Type}

From 0667b0c2ef7dd75fe6be266bc5255db1f8213c1c Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Fri, 29 Jul 2022 16:40:41 +0200
Subject: [PATCH 19/85] fix ormolu & build errors

---
 src/Juvix/Core/Evaluator.hs                  |  4 ++--
 src/Juvix/Core/Extra/Recursors.hs            |  2 +-
 src/Juvix/Core/Language.hs                   | 13 +++++++------
 src/Juvix/Core/Language/Base.hs              |  4 ++--
 src/Juvix/Core/Language/Info/FreeVarsInfo.hs |  4 ++--
 src/Juvix/Core/Language/Info/IdentInfo.hs    |  4 ++--
 src/Juvix/Core/Language/Type.hs              |  2 +-
 7 files changed, 17 insertions(+), 16 deletions(-)

diff --git a/src/Juvix/Core/Evaluator.hs b/src/Juvix/Core/Evaluator.hs
index ff262aafde..16b27861f0 100644
--- a/src/Juvix/Core/Evaluator.hs
+++ b/src/Juvix/Core/Evaluator.hs
@@ -2,9 +2,9 @@ module Juvix.Core.Evaluator where
 
 import Data.HashMap.Strict ((!))
 import Juvix.Core.Context
-import Juvix.Core.Language.Info qualified as Info
-import Juvix.Core.Language
 import Juvix.Core.Extra
+import Juvix.Core.Language
+import Juvix.Core.Language.Info qualified as Info
 
 -- `eval ctx env n` evalues a node `n` whose all free variables point into
 -- `env`. All nodes in `ctx` and `env` are closed and already evaluated.
diff --git a/src/Juvix/Core/Extra/Recursors.hs b/src/Juvix/Core/Extra/Recursors.hs
index 54a9ed74fe..b03e2f9b80 100644
--- a/src/Juvix/Core/Extra/Recursors.hs
+++ b/src/Juvix/Core/Extra/Recursors.hs
@@ -1,9 +1,9 @@
 module Juvix.Core.Extra.Recursors where
 
 import Data.Functor.Identity
+import Juvix.Core.Extra.Base
 import Juvix.Core.Language
 import Juvix.Core.Language.Info.BinderInfo
-import Juvix.Core.Extra.Base
 
 {---------------------------------------------------------------------------------}
 {- General recursors on Node  -}
diff --git a/src/Juvix/Core/Language.hs b/src/Juvix/Core/Language.hs
index 4e159fd28a..92578c6518 100644
--- a/src/Juvix/Core/Language.hs
+++ b/src/Juvix/Core/Language.hs
@@ -3,19 +3,20 @@
 
 {-# HLINT ignore "Avoid restricted flags" #-}
 
-module Juvix.Core.Language (
-  module Juvix.Core.Language,
-  module Juvix.Core.Language.Builtins,
-  module Juvix.Core.Language.Base
-) where
+module Juvix.Core.Language
+  ( module Juvix.Core.Language,
+    module Juvix.Core.Language.Builtins,
+    module Juvix.Core.Language.Base,
+  )
+where
 
 {-
   This file defines the tree representation of JuvixCore (Node datatype) and
   general recursors on it.
 -}
 
-import Juvix.Core.Language.Builtins
 import Juvix.Core.Language.Base
+import Juvix.Core.Language.Builtins
 
 {---------------------------------------------------------------------------------}
 {- Program tree datatype -}
diff --git a/src/Juvix/Core/Language/Base.hs b/src/Juvix/Core/Language/Base.hs
index 42424eb7d4..87678189c4 100644
--- a/src/Juvix/Core/Language/Base.hs
+++ b/src/Juvix/Core/Language/Base.hs
@@ -5,11 +5,11 @@ module Juvix.Core.Language.Base
     module Juvix.Prelude,
     module Juvix.Prelude.Loc,
     module Juvix.Syntax.Abstract.Name,
-    Location
+    Location,
   )
 where
 
-import Juvix.Core.Language.Info (Info, Key, IsInfo)
+import Juvix.Core.Language.Info (Info, IsInfo, Key)
 import Juvix.Prelude
 import Juvix.Prelude.Loc
 import Juvix.Syntax.Abstract.Name
diff --git a/src/Juvix/Core/Language/Info/FreeVarsInfo.hs b/src/Juvix/Core/Language/Info/FreeVarsInfo.hs
index 30ad9eaebd..d4733affbc 100644
--- a/src/Juvix/Core/Language/Info/FreeVarsInfo.hs
+++ b/src/Juvix/Core/Language/Info/FreeVarsInfo.hs
@@ -1,9 +1,9 @@
 module Juvix.Core.Language.Info.FreeVarsInfo where
 
 import Data.HashMap.Strict qualified as HashMap
-import Juvix.Core.Language.Info qualified as Info
-import Juvix.Core.Language
 import Juvix.Core.Extra
+import Juvix.Core.Language
+import Juvix.Core.Language.Info qualified as Info
 
 newtype FreeVarsInfo = FreeVarsInfo
   { -- map free variables to the number of their occurrences
diff --git a/src/Juvix/Core/Language/Info/IdentInfo.hs b/src/Juvix/Core/Language/Info/IdentInfo.hs
index 69ae26e4a7..7520aaa75e 100644
--- a/src/Juvix/Core/Language/Info/IdentInfo.hs
+++ b/src/Juvix/Core/Language/Info/IdentInfo.hs
@@ -1,9 +1,9 @@
 module Juvix.Core.Language.Info.IdentInfo where
 
 import Data.HashMap.Strict qualified as HashMap
-import Juvix.Core.Language.Info qualified as Info
-import Juvix.Core.Language
 import Juvix.Core.Extra
+import Juvix.Core.Language
+import Juvix.Core.Language.Info qualified as Info
 
 newtype IdentInfo = IdentInfo
   { -- map symbols to the number of their occurrences
diff --git a/src/Juvix/Core/Language/Type.hs b/src/Juvix/Core/Language/Type.hs
index c944428ddf..8fbea3c0dd 100644
--- a/src/Juvix/Core/Language/Type.hs
+++ b/src/Juvix/Core/Language/Type.hs
@@ -1,6 +1,6 @@
 module Juvix.Core.Language.Type where
 
-import Juvix.Core.Prelude
+import Juvix.Core.Language.Base
 
 data Type = Atomic Atom | Fun Type Type | Universe
 

From c8ee435f748338fec6b8168fc228cecee879dd6f Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Mon, 1 Aug 2022 11:39:20 +0200
Subject: [PATCH 20/85] refactor

---
 src/Juvix/Core/Evaluator.hs                   | 21 ++++++++-------
 src/Juvix/Core/Extra.hs                       |  2 +-
 src/Juvix/Core/Extra/Base.hs                  |  8 +++---
 src/Juvix/Core/Language.hs                    | 27 ++++++++++++-------
 .../Core/{Context.hs => Types/InfoTable.hs}   |  6 ++---
 5 files changed, 37 insertions(+), 27 deletions(-)
 rename src/Juvix/Core/{Context.hs => Types/InfoTable.hs} (94%)

diff --git a/src/Juvix/Core/Evaluator.hs b/src/Juvix/Core/Evaluator.hs
index 16b27861f0..9a67850754 100644
--- a/src/Juvix/Core/Evaluator.hs
+++ b/src/Juvix/Core/Evaluator.hs
@@ -1,10 +1,10 @@
 module Juvix.Core.Evaluator where
 
 import Data.HashMap.Strict ((!))
-import Juvix.Core.Context
 import Juvix.Core.Extra
 import Juvix.Core.Language
 import Juvix.Core.Language.Info qualified as Info
+import Juvix.Core.Types.InfoTable
 
 -- `eval ctx env n` evalues a node `n` whose all free variables point into
 -- `env`. All nodes in `ctx` and `env` are closed and already evaluated.
@@ -29,8 +29,8 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
       Ident _ sym -> ctx ! sym
       Builtin _ op -> mkBuiltinClosure env op
       Constructor _ tag -> mkConstructorClosure env tag
-      ConstValue _ _ -> n
-      Axiom _ -> n
+      Constant {} -> n
+      Axiom {} -> n
       App _ l r ->
         -- The semantics for evaluating application (App l r) is:
         --
@@ -44,19 +44,19 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
         -- application arguments, evaluate them from left to right and
         -- push the results onto the environment.
         apply env l r []
-      Lambda i b -> LambdaClosure i env b
-      LetIn _ v b -> let !v' = eval' env v in eval' (v' : env) b
+      Lambda i b -> Closure i env b
+      Let _ v b -> let !v' = eval' env v in eval' (v' : env) b
       Case _ v bs def ->
         case eval' env v of
           Data _ tag args -> branch env (args ++ env) tag def bs
           _ -> evalError
       If _ v b1 b2 ->
         case eval' env v of
-          ConstValue _ (ConstBool True) -> eval' env b1
-          ConstValue _ (ConstBool False) -> eval' env b2
+          Constant _ (ConstBool True) -> eval' env b1
+          Constant _ (ConstBool False) -> eval' env b2
           _ -> evalError
       Data {} -> n
-      LambdaClosure {} -> n
+      Closure {} -> n
       Suspended {} -> n
 
     apply :: Env -> Node -> Node -> [Node] -> Node
@@ -69,12 +69,13 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
     push :: Env -> Env -> Node -> Node -> [Node] -> Node
     push !env !env' !n !a !args = case n of
       Lambda _ b -> push' env (eval' env a : env') b args
-      LambdaClosure _ env'' b -> push' env (eval' env a : env'') b args
+      Closure _ env'' b -> push' env (eval' env a : env'') b args
       Constructor {} -> unimplemented
       Builtin {} -> unimplemented
-      ConstValue {} -> evalError
+      Constant {} -> evalError
       Data {} -> evalError
       Axiom {} -> Suspended Info.empty (mkApp' n (map (eval' env) args))
+      Suspended i t -> Suspended i (mkApp' t (map (eval' env) args))
       _ -> push env env' (eval' env' n) a args
 
     push' :: Env -> Env -> Node -> [Node] -> Node
diff --git a/src/Juvix/Core/Extra.hs b/src/Juvix/Core/Extra.hs
index 6c05ef7396..12388c90ff 100644
--- a/src/Juvix/Core/Extra.hs
+++ b/src/Juvix/Core/Extra.hs
@@ -81,7 +81,7 @@ convertClosures = umap go
   where
     go :: Node -> Node
     go n = case n of
-      LambdaClosure i env b -> substEnv env (Lambda i b)
+      Closure i env b -> substEnv env (Lambda i b)
       _ -> n
 
 convertData :: Node -> Node
diff --git a/src/Juvix/Core/Extra/Base.hs b/src/Juvix/Core/Extra/Base.hs
index f12c571775..7eb4542901 100644
--- a/src/Juvix/Core/Extra/Base.hs
+++ b/src/Juvix/Core/Extra/Base.hs
@@ -76,11 +76,11 @@ destruct = \case
   Ident i sym -> NodeDetails i [] [] [] (\i' _ -> Ident i' sym)
   Builtin i op -> NodeDetails i [] [] [] (\i' _ -> Builtin i' op)
   Constructor i tag -> NodeDetails i [] [] [] (\i' _ -> Constructor i' tag)
-  ConstValue i c -> NodeDetails i [] [] [] (\i' _ -> ConstValue i' c)
+  Constant i c -> NodeDetails i [] [] [] (\i' _ -> Constant i' c)
   Axiom i -> NodeDetails i [] [] [] (\i' _ -> Axiom i')
   App i l r -> NodeDetails i [l, r] [0, 0] [Nothing, Nothing] (\i' args' -> App i' (hd args') (args' !! 1))
   Lambda i b -> NodeDetails i [b] [1] [fetchBinderInfo i] (\i' args' -> Lambda i' (hd args'))
-  LetIn i v b -> NodeDetails i [v, b] [0, 1] [Nothing, fetchBinderInfo i] (\i' args' -> LetIn i' (hd args') (args' !! 1))
+  Let i v b -> NodeDetails i [v, b] [0, 1] [Nothing, fetchBinderInfo i] (\i' args' -> Let i' (hd args') (args' !! 1))
   Case i v bs Nothing ->
     NodeDetails
       i
@@ -124,13 +124,13 @@ destruct = \case
       (\i' args' -> If i' (hd args') (args' !! 1) (args' !! 2))
   Data i tag args ->
     NodeDetails i args (map (const 0) args) (map (const Nothing) args) (`Data` tag)
-  LambdaClosure i env b ->
+  Closure i env b ->
     NodeDetails
       i
       (b : env)
       (1 : map (const 0) env)
       (fetchBinderInfo i : map (const Nothing) env)
-      (\i' args' -> LambdaClosure i' (tl args') (hd args'))
+      (\i' args' -> Closure i' (tl args') (hd args'))
   Suspended i t ->
     NodeDetails i [t] [0] [Nothing] (\i' args' -> Suspended i' (hd args'))
   where
diff --git a/src/Juvix/Core/Language.hs b/src/Juvix/Core/Language.hs
index 92578c6518..7931a9db1f 100644
--- a/src/Juvix/Core/Language.hs
+++ b/src/Juvix/Core/Language.hs
@@ -50,14 +50,14 @@ data Node
     Builtin {builtinInfo :: !Info, builtinOp :: !BuiltinOp}
   | -- A data constructor (the function that creates the data).
     Constructor {constructorInfo :: !Info, constructorTag :: !Tag}
-  | ConstValue {constantInfo :: !Info, constantValue :: !Constant}
+  | Constant {constantInfo :: !Info, constantValue :: !ConstantValue}
   | -- An axiom. Computationally a unit.
     Axiom {axiomInfo :: !Info}
   | App {appInfo :: !Info, appLeft :: !Node, appRight :: !Node}
   | Lambda {lambdaInfo :: !Info, lambdaBody :: !Node}
   | -- `let x := value in body` is not reducible to lambda + application for the purposes
     -- of ML-polymorphic / dependent type checking or code generation!
-    LetIn {letInfo :: !Info, letValue :: !Node, letBody :: !Node}
+    Let {letInfo :: !Info, letValue :: !Node, letBody :: !Node}
   | -- One-level case matching on the tag of a data constructor: `Case value
     -- branches default`. `Case` is lazy: only the selected branch is evaluated.
     Case
@@ -75,17 +75,17 @@ data Node
         ifFalseBranch :: !Node
       }
   | -- Evaluation only: evaluated data constructor (the actual data). Arguments
-    -- order: right to left. Arguments are closed values.
+    -- order: right to left. Arguments are values (see below).
     Data {dataInfo :: !Info, dataTag :: !Tag, dataArgs :: ![Node]}
-  | -- Evaluation only: `LambdaClosure env body`
-    LambdaClosure
+  | -- Evaluation only: `Closure env body`
+    Closure
       { closureInfo :: !Info,
         closureEnv :: !Env,
         closureBody :: !Node
       }
   | -- Evaluation only: a suspended term value which cannot be evaluated
     -- further, e.g., a hole applied to some arguments. The suspended term must
-    -- be closed.
+    -- be closed (but need not be a value -- see below).
     Suspended {suspendedInfo :: !Info, suspendedNode :: !Node}
 
 -- Other things we might need in the future:
@@ -98,7 +98,7 @@ data Node
 --   TypeIdent (named type identifier available in the global context, e.g.,
 --   inductive type), Universe
 
-data Constant
+data ConstantValue
   = ConstInteger !Integer
   | ConstBool !Bool
 
@@ -111,6 +111,15 @@ data Constant
 --   equal to the number of implicit binders above `branch`
 data CaseBranch = CaseBranch {caseTag :: !Tag, caseBindersNum :: !Int, caseBranch :: !Node}
 
--- all nodes in an environment must be closed values (no free variables, i.e.,
--- no de Bruijn indices pointing outside the term)
+-- Values are closed nodes (no free variables, i.e., no de Bruijn indices
+-- pointing outside the term) of the following kinds:
+-- - Constant
+-- - Data
+-- - Closure
+-- - Suspended
+--
+-- Whether something is a value matters only for evaluation semantics. It
+-- doesn't matter much outside the evaluator.
+
+-- all nodes in an environment must be values
 type Env = [Node]
diff --git a/src/Juvix/Core/Context.hs b/src/Juvix/Core/Types/InfoTable.hs
similarity index 94%
rename from src/Juvix/Core/Context.hs
rename to src/Juvix/Core/Types/InfoTable.hs
index bcbc9fd67f..5eecff7340 100644
--- a/src/Juvix/Core/Context.hs
+++ b/src/Juvix/Core/Types/InfoTable.hs
@@ -1,11 +1,11 @@
-module Juvix.Core.Context where
+module Juvix.Core.Types.InfoTable where
 
 import Juvix.Core.Language
 import Juvix.Core.Language.Type
 
 type IdentContext = HashMap Symbol Node
 
-data Context = Context
+data InfoTable = InfoTable
   { _identContext :: IdentContext,
     _identInfo :: HashMap Symbol IdentInfo,
     _inductiveInfo :: HashMap Name InductiveInfo,
@@ -54,7 +54,7 @@ data AxiomInfo = AxiomInfo
     _axiomType :: Type
   }
 
-makeLenses ''Context
+makeLenses ''InfoTable
 makeLenses ''IdentInfo
 makeLenses ''ArgumentInfo
 makeLenses ''InductiveInfo

From d7221a4b23d261b2b80dd93d6b6717466d118c69 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Mon, 1 Aug 2022 13:40:04 +0200
Subject: [PATCH 21/85] evaluator

---
 src/Juvix/Core/Evaluator.hs         | 93 ++++++++++++++++++++---------
 src/Juvix/Core/Extra.hs             | 24 +++++++-
 src/Juvix/Core/Extra/Base.hs        | 13 +++-
 src/Juvix/Core/Language.hs          | 29 ++++++---
 src/Juvix/Core/Language/Builtins.hs | 29 +++++++--
 5 files changed, 143 insertions(+), 45 deletions(-)

diff --git a/src/Juvix/Core/Evaluator.hs b/src/Juvix/Core/Evaluator.hs
index 9a67850754..4f2dfb8317 100644
--- a/src/Juvix/Core/Evaluator.hs
+++ b/src/Juvix/Core/Evaluator.hs
@@ -1,34 +1,40 @@
 module Juvix.Core.Evaluator where
 
+import Control.Exception qualified as Exception
 import Data.HashMap.Strict ((!))
+import GHC.Show
 import Juvix.Core.Extra
 import Juvix.Core.Language
 import Juvix.Core.Language.Info qualified as Info
 import Juvix.Core.Types.InfoTable
 
+newtype EvalError = EvalError String
+
+instance Show EvalError where
+  show :: EvalError -> String
+  show (EvalError msg) = "evaluation error: " ++ msg
+
+instance Exception.Exception EvalError
+
+-- We definitely do *not* want to wrap the evaluator in an exception monad / the
+-- polysemy effects! This would almost double the execution time. Evaluation
+-- errors should not happen for well-typed input (except perhaps division by
+-- zero), so it is reasonable to catch them only at the CLI toplevel and just
+-- exit when they occur.
+
 -- `eval ctx env n` evalues a node `n` whose all free variables point into
--- `env`. All nodes in `ctx` and `env` are closed and already evaluated.
+-- `env`. All nodes in `ctx` must be closed. All nodes in `env` must be values.
+-- Invariant for values v: eval ctx env v = v
 eval :: IdentContext -> Env -> Node -> Node
 eval !ctx !env0 = convertRuntimeNodes . eval' env0
   where
-    unimplemented :: a
-    unimplemented = error "not yet implemented"
-
-    evalError :: a
-    evalError = error "evaluation error"
-
-    mkBuiltinClosure :: Env -> BuiltinOp -> Node
-    mkBuiltinClosure = unimplemented
-
-    mkConstructorClosure :: Env -> Tag -> Node
-    mkConstructorClosure = unimplemented
+    evalError :: String -> a
+    evalError msg = Exception.throw (EvalError msg)
 
     eval' :: Env -> Node -> Node
     eval' !env !n = case n of
       Var _ idx -> env !! idx
-      Ident _ sym -> ctx ! sym
-      Builtin _ op -> mkBuiltinClosure env op
-      Constructor _ tag -> mkConstructorClosure env tag
+      Ident _ sym -> eval' [] (ctx ! sym)
       Constant {} -> n
       Axiom {} -> n
       App _ l r ->
@@ -36,25 +42,27 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
         --
         -- eval env (App l r) =
         --   case eval env l of
-        --     LambdaClosure env' b -> eval (eval env r : env') b
+        --     Closure env' b ->
+        --       let !v = eval env r in eval (v : env') b
         --
-        -- To do this more efficently for builtins, constructors and
-        -- multi-argument functions (without creating closures for each
-        -- intermediate function and matching each twice) we gather all
-        -- application arguments, evaluate them from left to right and
-        -- push the results onto the environment.
+        -- To do this more efficently for multi-argument functions (without
+        -- creating closures for each intermediate function and matching each
+        -- twice) we gather all application arguments, evaluate them from left
+        -- to right and push the results onto the environment.
         apply env l r []
+      BuiltinApp _ op args -> applyBuiltin env op args
+      ConstructorApp i tag args -> Data i tag (map (eval' env) args)
       Lambda i b -> Closure i env b
       Let _ v b -> let !v' = eval' env v in eval' (v' : env) b
       Case _ v bs def ->
         case eval' env v of
           Data _ tag args -> branch env (args ++ env) tag def bs
-          _ -> evalError
+          _ -> evalError "matching on non-data"
       If _ v b1 b2 ->
         case eval' env v of
           Constant _ (ConstBool True) -> eval' env b1
           Constant _ (ConstBool False) -> eval' env b2
-          _ -> evalError
+          _ -> evalError "conditional branch on a non-boolean"
       Data {} -> n
       Closure {} -> n
       Suspended {} -> n
@@ -70,12 +78,13 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
     push !env !env' !n !a !args = case n of
       Lambda _ b -> push' env (eval' env a : env') b args
       Closure _ env'' b -> push' env (eval' env a : env'') b args
-      Constructor {} -> unimplemented
-      Builtin {} -> unimplemented
-      Constant {} -> evalError
-      Data {} -> evalError
+      Constant {} -> evalError "applying a constant to an argument"
+      ConstructorApp {} -> evalError "constructor applied to too many arguments"
+      BuiltinApp {} -> evalError "builtin applied to too many arguments"
+      Data {} -> evalError "constructor applied to too many arguments"
       Axiom {} -> Suspended Info.empty (mkApp' n (map (eval' env) args))
       Suspended i t -> Suspended i (mkApp' t (map (eval' env) args))
+      Ident _ sym -> push env env' (ctx ! sym) a args
       _ -> push env env' (eval' env' n) a args
 
     push' :: Env -> Env -> Node -> [Node] -> Node
@@ -89,4 +98,32 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
       _ : bs' -> branch denv env tag def bs'
       [] -> case def of
         Just b -> eval' denv b
-        Nothing -> evalError
+        Nothing -> evalError "no matching case branch"
+
+    applyBuiltin :: Env -> BuiltinOp -> [Node] -> Node
+    applyBuiltin env OpIntAdd [l, r] = nodeFromInteger (integerFromNode (eval' env l) + integerFromNode (eval' env r))
+    applyBuiltin env OpIntSub [l, r] = nodeFromInteger (integerFromNode (eval' env l) - integerFromNode (eval' env r))
+    applyBuiltin env OpIntMul [l, r] = nodeFromInteger (integerFromNode (eval' env l) * integerFromNode (eval' env r))
+    applyBuiltin env OpIntDiv [l, r] = nodeFromInteger (div (integerFromNode (eval' env l)) (integerFromNode (eval' env r)))
+    applyBuiltin env OpIntEq [l, r] = nodeFromBool (integerFromNode (eval' env l) == integerFromNode (eval' env r))
+    applyBuiltin env OpIntLt [l, r] = nodeFromBool (integerFromNode (eval' env l) < integerFromNode (eval' env r))
+    applyBuiltin env OpIntLe [l, r] = nodeFromBool (integerFromNode (eval' env l) <= integerFromNode (eval' env r))
+    applyBuiltin env OpBoolAnd [l, r] = nodeFromBool (boolFromNode (eval' env l) && boolFromNode (eval' env r))
+    applyBuiltin env OpBoolOr [l, r] = nodeFromBool (boolFromNode (eval' env l) || boolFromNode (eval' env r))
+    applyBuiltin _ _ _ = evalError "unrecognised builtin application"
+
+    nodeFromInteger :: Integer -> Node
+    nodeFromInteger !int = Constant Info.empty (ConstInteger int)
+
+    nodeFromBool :: Bool -> Node
+    nodeFromBool !b = Constant Info.empty (ConstBool b)
+
+    integerFromNode :: Node -> Integer
+    integerFromNode = \case
+      Constant _ (ConstInteger int) -> int
+      _ -> evalError "not an integer"
+
+    boolFromNode :: Node -> Bool
+    boolFromNode = \case
+      Constant _ (ConstBool b) -> b
+      _ -> evalError "not a boolean"
diff --git a/src/Juvix/Core/Extra.hs b/src/Juvix/Core/Extra.hs
index 12388c90ff..ddbde48e71 100644
--- a/src/Juvix/Core/Extra.hs
+++ b/src/Juvix/Core/Extra.hs
@@ -10,6 +10,8 @@ import Juvix.Core.Extra.Base
 import Juvix.Core.Extra.Recursors
 import Juvix.Core.Language
 
+-- `isClosed` may short-circuit evaluation due to the use of `&&`, so it's not
+-- entirely reducible to `getFreeVars` in terms of computation time.
 isClosed :: Node -> Bool
 isClosed = ufoldN (&&) go
   where
@@ -89,7 +91,7 @@ convertData = umap go
   where
     go :: Node -> Node
     go n = case n of
-      Data i tag args -> mkApp' (Constructor i tag) args
+      Data i tag args -> ConstructorApp i tag args
       _ -> n
 
 convertSuspended :: Node -> Node
@@ -102,3 +104,23 @@ convertSuspended = umap go
 
 convertRuntimeNodes :: Node -> Node
 convertRuntimeNodes = convertSuspended . convertData . convertClosures
+
+etaExpandBuiltins :: Node -> Node
+etaExpandBuiltins = umap go
+  where
+    go :: Node -> Node
+    go n = case n of
+      BuiltinApp {..}
+        | builtinOpArgsNum builtinOp > length builtinArgs ->
+            etaExpand (builtinOpArgsNum builtinOp - length builtinArgs) n
+      _ -> n
+
+etaExpandConstructors :: (Tag -> Int) -> Node -> Node
+etaExpandConstructors argsNum = umap go
+  where
+    go :: Node -> Node
+    go n = case n of
+      ConstructorApp {..}
+        | argsNum constructorTag > length constructorArgs ->
+            etaExpand (argsNum constructorTag - length constructorArgs) n
+      _ -> n
diff --git a/src/Juvix/Core/Extra/Base.hs b/src/Juvix/Core/Extra/Base.hs
index 7eb4542901..58068a7c9e 100644
--- a/src/Juvix/Core/Extra/Base.hs
+++ b/src/Juvix/Core/Extra/Base.hs
@@ -39,6 +39,12 @@ unfoldApp = go []
       App i l r -> go ((i, r) : acc) l
       _ -> (n, acc)
 
+mkLambdas :: [Info] -> Node -> Node
+mkLambdas is n = foldr Lambda n is
+
+mkLambdas' :: Int -> Node -> Node
+mkLambdas' k = mkLambdas (replicate k Info.empty)
+
 unfoldLambdas :: Node -> ([Info], Node)
 unfoldLambdas = go []
   where
@@ -47,6 +53,9 @@ unfoldLambdas = go []
       Lambda i b -> go (i : acc) b
       _ -> (acc, n)
 
+etaExpand :: Int -> Node -> Node
+etaExpand k n = mkLambdas' k (mkApp' n (map (Var Info.empty) [0 .. k - 1]))
+
 -- `NodeDetails` is a convenience datatype which provides the most commonly needed
 -- information about a node in a generic fashion.
 data NodeDetails = NodeDetails
@@ -74,11 +83,11 @@ destruct :: Node -> NodeDetails
 destruct = \case
   Var i idx -> NodeDetails i [] [] [] (\i' _ -> Var i' idx)
   Ident i sym -> NodeDetails i [] [] [] (\i' _ -> Ident i' sym)
-  Builtin i op -> NodeDetails i [] [] [] (\i' _ -> Builtin i' op)
-  Constructor i tag -> NodeDetails i [] [] [] (\i' _ -> Constructor i' tag)
   Constant i c -> NodeDetails i [] [] [] (\i' _ -> Constant i' c)
   Axiom i -> NodeDetails i [] [] [] (\i' _ -> Axiom i')
   App i l r -> NodeDetails i [l, r] [0, 0] [Nothing, Nothing] (\i' args' -> App i' (hd args') (args' !! 1))
+  BuiltinApp i op args -> NodeDetails i args (map (const 0) args) (map (const Nothing) args) (`BuiltinApp` op)
+  ConstructorApp i tag args -> NodeDetails i args (map (const 0) args) (map (const Nothing) args) (`ConstructorApp` tag)
   Lambda i b -> NodeDetails i [b] [1] [fetchBinderInfo i] (\i' args' -> Lambda i' (hd args'))
   Let i v b -> NodeDetails i [v, b] [0, 1] [Nothing, fetchBinderInfo i] (\i' args' -> Let i' (hd args') (args' !! 1))
   Case i v bs Nothing ->
diff --git a/src/Juvix/Core/Language.hs b/src/Juvix/Core/Language.hs
index 7931a9db1f..0921584a68 100644
--- a/src/Juvix/Core/Language.hs
+++ b/src/Juvix/Core/Language.hs
@@ -11,8 +11,7 @@ module Juvix.Core.Language
 where
 
 {-
-  This file defines the tree representation of JuvixCore (Node datatype) and
-  general recursors on it.
+  This file defines the tree representation of JuvixCore (Node datatype).
 -}
 
 import Juvix.Core.Language.Base
@@ -29,7 +28,9 @@ type Symbol = Word
 -- "builtin" constructors, e.g., unit, nat, lists, pairs, so that the code
 -- generator can treat them specially.
 data Tag = BuiltinTag BuiltinDataTag | UserTag Word
-  deriving stock (Eq)
+  deriving stock (Eq, Generic)
+
+instance Hashable Tag
 
 -- de Bruijn index
 type Index = Int
@@ -44,16 +45,25 @@ data Node
   | -- Global identifier of a function (with corresponding `Node` in the global
     -- context).
     Ident {identInfo :: !Info, identSymbol :: !Symbol}
-  | -- A builtin with no corresponding Node, treated specially by the evaluator
-    -- and the code generator. For example, basic arithmetic operations go into
-    -- `Builtin`.
-    Builtin {builtinInfo :: !Info, builtinOp :: !BuiltinOp}
-  | -- A data constructor (the function that creates the data).
-    Constructor {constructorInfo :: !Info, constructorTag :: !Tag}
   | Constant {constantInfo :: !Info, constantValue :: !ConstantValue}
   | -- An axiom. Computationally a unit.
     Axiom {axiomInfo :: !Info}
   | App {appInfo :: !Info, appLeft :: !Node, appRight :: !Node}
+  | -- A builtin application. A builtin has no corresponding Node. It is treated
+    -- specially by the evaluator and the code generator. For example, basic
+    -- arithmetic operations go into `Builtin`. The number of arguments supplied
+    -- must be equal to the number of arguments expected by the builtin
+    -- operation (this simplifies evaluation and code generation). If you need
+    -- partial application, eta-expand with lambdas, e.g., eta-expand `(+) 2` to
+    -- `\x -> (+) 2 x`. See `etaExpand` in Extra/Base.hs and `etaExpand*` in Extra.hs.
+    BuiltinApp {builtinInfo :: !Info, builtinOp :: !BuiltinOp, builtinArgs :: ![Node]}
+  | -- A data constructor application. The number of arguments supplied must be
+    -- equal to the number of arguments expected by the constructor.
+    ConstructorApp
+      { constructorInfo :: !Info,
+        constructorTag :: !Tag,
+        constructorArgs :: ![Node]
+      }
   | Lambda {lambdaInfo :: !Info, lambdaBody :: !Node}
   | -- `let x := value in body` is not reducible to lambda + application for the purposes
     -- of ML-polymorphic / dependent type checking or code generation!
@@ -114,6 +124,7 @@ data CaseBranch = CaseBranch {caseTag :: !Tag, caseBindersNum :: !Int, caseBranc
 -- Values are closed nodes (no free variables, i.e., no de Bruijn indices
 -- pointing outside the term) of the following kinds:
 -- - Constant
+-- - Axiom
 -- - Data
 -- - Closure
 -- - Suspended
diff --git a/src/Juvix/Core/Language/Builtins.hs b/src/Juvix/Core/Language/Builtins.hs
index c8c1c8b546..1ae6631765 100644
--- a/src/Juvix/Core/Language/Builtins.hs
+++ b/src/Juvix/Core/Language/Builtins.hs
@@ -11,13 +11,9 @@ data BuiltinOp
   | OpIntDiv
   | OpIntEq
   | OpIntLt
-  | OpIntGt
   | OpIntLe
-  | OpIntGe
   | OpBoolAnd
   | OpBoolOr
-  | OpPairFst
-  | OpPairSnd
   deriving stock (Eq)
 
 -- Builtin data tags
@@ -28,4 +24,27 @@ data BuiltinDataTag
   | TagNil
   | TagCons
   | TagPair
-  deriving stock (Eq)
+  deriving stock (Eq, Generic)
+
+instance Hashable BuiltinDataTag
+
+builtinOpArgsNum :: BuiltinOp -> Int
+builtinOpArgsNum = \case
+  OpIntAdd -> 2
+  OpIntSub -> 2
+  OpIntMul -> 2
+  OpIntDiv -> 2
+  OpIntEq -> 2
+  OpIntLt -> 2
+  OpIntLe -> 2
+  OpBoolAnd -> 2
+  OpBoolOr -> 2
+
+builtinConstrArgsNum :: BuiltinDataTag -> Int
+builtinConstrArgsNum = \case
+  TagZero -> 0
+  TagSucc -> 1
+  TagUnit -> 0
+  TagNil -> 0
+  TagCons -> 2
+  TagPair -> 2

From 229761700158c852db635411bf5e44357444b8c3 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Mon, 1 Aug 2022 13:43:30 +0200
Subject: [PATCH 22/85] bang patterns

---
 src/Juvix/Core/Evaluator.hs | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/src/Juvix/Core/Evaluator.hs b/src/Juvix/Core/Evaluator.hs
index 4f2dfb8317..2dd53cbad4 100644
--- a/src/Juvix/Core/Evaluator.hs
+++ b/src/Juvix/Core/Evaluator.hs
@@ -1,3 +1,8 @@
+{-# LANGUAGE BangPatterns #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+{-# HLINT ignore "Avoid restricted extensions" #-}
+{-# HLINT ignore "Avoid restricted flags" #-}
+
 module Juvix.Core.Evaluator where
 
 import Control.Exception qualified as Exception

From df78c570868c8095676c162e22f6deec2e7f1058 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Mon, 1 Aug 2022 13:44:53 +0200
Subject: [PATCH 23/85] make ormolu happy

---
 src/Juvix/Core/Evaluator.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/Juvix/Core/Evaluator.hs b/src/Juvix/Core/Evaluator.hs
index 2dd53cbad4..94cb1d9f35 100644
--- a/src/Juvix/Core/Evaluator.hs
+++ b/src/Juvix/Core/Evaluator.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE BangPatterns #-}
 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
 {-# HLINT ignore "Avoid restricted extensions" #-}
 {-# HLINT ignore "Avoid restricted flags" #-}
 

From 130df4b55b93db97edf2c5a8b4d3fa8a6fa41789 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Tue, 2 Aug 2022 09:48:59 +0200
Subject: [PATCH 24/85] evaluator: more readable but slightly slower handling
 of application

---
 src/Juvix/Core/Evaluator.hs  | 48 ++++++------------------------------
 src/Juvix/Core/Extra.hs      |  8 +++---
 src/Juvix/Core/Extra/Base.hs |  2 +-
 src/Juvix/Core/Language.hs   |  2 +-
 4 files changed, 14 insertions(+), 46 deletions(-)

diff --git a/src/Juvix/Core/Evaluator.hs b/src/Juvix/Core/Evaluator.hs
index 94cb1d9f35..c6e6140186 100644
--- a/src/Juvix/Core/Evaluator.hs
+++ b/src/Juvix/Core/Evaluator.hs
@@ -22,7 +22,7 @@ instance Show EvalError where
 
 instance Exception.Exception EvalError
 
--- We definitely do *not* want to wrap the evaluator in an exception monad / the
+-- We definitely do _not_ want to wrap the evaluator in an exception monad / the
 -- polysemy effects! This would almost double the execution time. Evaluation
 -- errors should not happen for well-typed input (except perhaps division by
 -- zero), so it is reasonable to catch them only at the CLI toplevel and just
@@ -44,20 +44,13 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
       Constant {} -> n
       Axiom {} -> n
       App _ l r ->
-        -- The semantics for evaluating application (App l r) is:
-        --
-        -- eval env (App l r) =
-        --   case eval env l of
-        --     Closure env' b ->
-        --       let !v = eval env r in eval (v : env') b
-        --
-        -- To do this more efficently for multi-argument functions (without
-        -- creating closures for each intermediate function and matching each
-        -- twice) we gather all application arguments, evaluate them from left
-        -- to right and push the results onto the environment.
-        apply env l r []
+        case eval' env l of
+          Closure _ env' b -> let !v = eval' env r in eval' (v : env') b
+          a@(Axiom {}) -> Suspended Info.empty (App Info.empty a (eval' env r))
+          Suspended i t -> Suspended i (App Info.empty t (eval' env r))
+          _ -> evalError "invalid application"
       BuiltinApp _ op args -> applyBuiltin env op args
-      ConstructorApp i tag args -> Data i tag (map (eval' env) args)
+      ConstrApp i tag args -> Data i tag (map (eval' env) args)
       Lambda i b -> Closure i env b
       Let _ v b -> let !v' = eval' env v in eval' (v' : env) b
       Case _ v bs def ->
@@ -73,31 +66,6 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
       Closure {} -> n
       Suspended {} -> n
 
-    apply :: Env -> Node -> Node -> [Node] -> Node
-    apply !env !n !a !args = case n of
-      App _ l r -> apply env l r (a : args)
-      _ -> push env env n a args
-
-    -- In `push env env' n args`, `a` is the first argument, `env` is the
-    -- environment of `a` and `args`, `env'` the environment of `n`.
-    push :: Env -> Env -> Node -> Node -> [Node] -> Node
-    push !env !env' !n !a !args = case n of
-      Lambda _ b -> push' env (eval' env a : env') b args
-      Closure _ env'' b -> push' env (eval' env a : env'') b args
-      Constant {} -> evalError "applying a constant to an argument"
-      ConstructorApp {} -> evalError "constructor applied to too many arguments"
-      BuiltinApp {} -> evalError "builtin applied to too many arguments"
-      Data {} -> evalError "constructor applied to too many arguments"
-      Axiom {} -> Suspended Info.empty (mkApp' n (map (eval' env) args))
-      Suspended i t -> Suspended i (mkApp' t (map (eval' env) args))
-      Ident _ sym -> push env env' (ctx ! sym) a args
-      _ -> push env env' (eval' env' n) a args
-
-    push' :: Env -> Env -> Node -> [Node] -> Node
-    push' !env !env' !n !args = case args of
-      a : args' -> push env env' n a args'
-      [] -> eval' env' n
-
     branch :: Env -> Env -> Tag -> Maybe Node -> [CaseBranch] -> Node
     branch !denv !env !tag !def = \case
       (CaseBranch tag' _ b) : _ | tag' == tag -> eval' env b
@@ -116,7 +84,7 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
     applyBuiltin env OpIntLe [l, r] = nodeFromBool (integerFromNode (eval' env l) <= integerFromNode (eval' env r))
     applyBuiltin env OpBoolAnd [l, r] = nodeFromBool (boolFromNode (eval' env l) && boolFromNode (eval' env r))
     applyBuiltin env OpBoolOr [l, r] = nodeFromBool (boolFromNode (eval' env l) || boolFromNode (eval' env r))
-    applyBuiltin _ _ _ = evalError "unrecognised builtin application"
+    applyBuiltin _ _ _ = evalError "invalid builtin application"
 
     nodeFromInteger :: Integer -> Node
     nodeFromInteger !int = Constant Info.empty (ConstInteger int)
diff --git a/src/Juvix/Core/Extra.hs b/src/Juvix/Core/Extra.hs
index ddbde48e71..1a50d34c37 100644
--- a/src/Juvix/Core/Extra.hs
+++ b/src/Juvix/Core/Extra.hs
@@ -91,7 +91,7 @@ convertData = umap go
   where
     go :: Node -> Node
     go n = case n of
-      Data i tag args -> ConstructorApp i tag args
+      Data i tag args -> ConstrApp i tag args
       _ -> n
 
 convertSuspended :: Node -> Node
@@ -115,12 +115,12 @@ etaExpandBuiltins = umap go
             etaExpand (builtinOpArgsNum builtinOp - length builtinArgs) n
       _ -> n
 
-etaExpandConstructors :: (Tag -> Int) -> Node -> Node
-etaExpandConstructors argsNum = umap go
+etaExpandConstrs :: (Tag -> Int) -> Node -> Node
+etaExpandConstrs argsNum = umap go
   where
     go :: Node -> Node
     go n = case n of
-      ConstructorApp {..}
+      ConstrApp {..}
         | argsNum constructorTag > length constructorArgs ->
             etaExpand (argsNum constructorTag - length constructorArgs) n
       _ -> n
diff --git a/src/Juvix/Core/Extra/Base.hs b/src/Juvix/Core/Extra/Base.hs
index 58068a7c9e..5978d406d2 100644
--- a/src/Juvix/Core/Extra/Base.hs
+++ b/src/Juvix/Core/Extra/Base.hs
@@ -87,7 +87,7 @@ destruct = \case
   Axiom i -> NodeDetails i [] [] [] (\i' _ -> Axiom i')
   App i l r -> NodeDetails i [l, r] [0, 0] [Nothing, Nothing] (\i' args' -> App i' (hd args') (args' !! 1))
   BuiltinApp i op args -> NodeDetails i args (map (const 0) args) (map (const Nothing) args) (`BuiltinApp` op)
-  ConstructorApp i tag args -> NodeDetails i args (map (const 0) args) (map (const Nothing) args) (`ConstructorApp` tag)
+  ConstrApp i tag args -> NodeDetails i args (map (const 0) args) (map (const Nothing) args) (`ConstrApp` tag)
   Lambda i b -> NodeDetails i [b] [1] [fetchBinderInfo i] (\i' args' -> Lambda i' (hd args'))
   Let i v b -> NodeDetails i [v, b] [0, 1] [Nothing, fetchBinderInfo i] (\i' args' -> Let i' (hd args') (args' !! 1))
   Case i v bs Nothing ->
diff --git a/src/Juvix/Core/Language.hs b/src/Juvix/Core/Language.hs
index 0921584a68..e1f2bf3878 100644
--- a/src/Juvix/Core/Language.hs
+++ b/src/Juvix/Core/Language.hs
@@ -59,7 +59,7 @@ data Node
     BuiltinApp {builtinInfo :: !Info, builtinOp :: !BuiltinOp, builtinArgs :: ![Node]}
   | -- A data constructor application. The number of arguments supplied must be
     -- equal to the number of arguments expected by the constructor.
-    ConstructorApp
+    ConstrApp
       { constructorInfo :: !Info,
         constructorTag :: !Tag,
         constructorArgs :: ![Node]

From e929bef72cde76bbad1108945716f8967d3b9c9d Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Tue, 2 Aug 2022 09:57:27 +0200
Subject: [PATCH 25/85] refactor

---
 src/Juvix/Core/Extra.hs    | 4 ++--
 src/Juvix/Core/Language.hs | 6 +++---
 2 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/src/Juvix/Core/Extra.hs b/src/Juvix/Core/Extra.hs
index 1a50d34c37..f22612fa68 100644
--- a/src/Juvix/Core/Extra.hs
+++ b/src/Juvix/Core/Extra.hs
@@ -121,6 +121,6 @@ etaExpandConstrs argsNum = umap go
     go :: Node -> Node
     go n = case n of
       ConstrApp {..}
-        | argsNum constructorTag > length constructorArgs ->
-            etaExpand (argsNum constructorTag - length constructorArgs) n
+        | argsNum constrTag > length constrArgs ->
+            etaExpand (argsNum constrTag - length constrArgs) n
       _ -> n
diff --git a/src/Juvix/Core/Language.hs b/src/Juvix/Core/Language.hs
index e1f2bf3878..08741fa57b 100644
--- a/src/Juvix/Core/Language.hs
+++ b/src/Juvix/Core/Language.hs
@@ -60,9 +60,9 @@ data Node
   | -- A data constructor application. The number of arguments supplied must be
     -- equal to the number of arguments expected by the constructor.
     ConstrApp
-      { constructorInfo :: !Info,
-        constructorTag :: !Tag,
-        constructorArgs :: ![Node]
+      { constrInfo :: !Info,
+        constrTag :: !Tag,
+        constrArgs :: ![Node]
       }
   | Lambda {lambdaInfo :: !Info, lambdaBody :: !Node}
   | -- `let x := value in body` is not reducible to lambda + application for the purposes

From f7010840712272d84c4030450f316ced5830c3fe Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Tue, 2 Aug 2022 14:42:00 +0200
Subject: [PATCH 26/85] refactor

---
 src/Juvix/Core/Language.hs      | 14 --------------
 src/Juvix/Core/Language/Base.hs | 16 +++++++++++++++-
 2 files changed, 15 insertions(+), 15 deletions(-)

diff --git a/src/Juvix/Core/Language.hs b/src/Juvix/Core/Language.hs
index 08741fa57b..bdbff7e7e1 100644
--- a/src/Juvix/Core/Language.hs
+++ b/src/Juvix/Core/Language.hs
@@ -5,7 +5,6 @@
 
 module Juvix.Core.Language
   ( module Juvix.Core.Language,
-    module Juvix.Core.Language.Builtins,
     module Juvix.Core.Language.Base,
   )
 where
@@ -15,23 +14,10 @@ where
 -}
 
 import Juvix.Core.Language.Base
-import Juvix.Core.Language.Builtins
 
 {---------------------------------------------------------------------------------}
 {- Program tree datatype -}
 
--- Consecutive symbol IDs for reachable user functions.
-type Symbol = Word
-
--- Tag of a constructor, uniquely identifying it. Tag values are consecutive and
--- separate from symbol IDs. We might need fixed special tags in Core for common
--- "builtin" constructors, e.g., unit, nat, lists, pairs, so that the code
--- generator can treat them specially.
-data Tag = BuiltinTag BuiltinDataTag | UserTag Word
-  deriving stock (Eq, Generic)
-
-instance Hashable Tag
-
 -- de Bruijn index
 type Index = Int
 
diff --git a/src/Juvix/Core/Language/Base.hs b/src/Juvix/Core/Language/Base.hs
index 87678189c4..4918f750a6 100644
--- a/src/Juvix/Core/Language/Base.hs
+++ b/src/Juvix/Core/Language/Base.hs
@@ -2,16 +2,30 @@ module Juvix.Core.Language.Base
   ( Info,
     Key,
     IsInfo,
+    module Juvix.Core.Language.Base,
+    module Juvix.Core.Language.Builtins,
     module Juvix.Prelude,
     module Juvix.Prelude.Loc,
     module Juvix.Syntax.Abstract.Name,
-    Location,
   )
 where
 
+import Juvix.Core.Language.Builtins
 import Juvix.Core.Language.Info (Info, IsInfo, Key)
 import Juvix.Prelude
 import Juvix.Prelude.Loc
 import Juvix.Syntax.Abstract.Name
 
 type Location = Interval
+
+-- Consecutive symbol IDs for reachable user functions.
+type Symbol = Word
+
+-- Tag of a constructor, uniquely identifying it. Tag values are consecutive and
+-- separate from symbol IDs. We might need fixed special tags in Core for common
+-- "builtin" constructors, e.g., unit, nat, lists, pairs, so that the code
+-- generator can treat them specially.
+data Tag = BuiltinTag BuiltinDataTag | UserTag Word
+  deriving stock (Eq, Generic)
+
+instance Hashable Tag

From b644b2106a68ee12fa0e16a03f4329e14b9469f8 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Tue, 2 Aug 2022 18:06:06 +0200
Subject: [PATCH 27/85] refactor

---
 src/Juvix/Core/{Types => Data}/InfoTable.hs |  2 +-
 src/Juvix/Core/Evaluator.hs                 |  2 +-
 src/Juvix/Core/Extra.hs                     |  4 +++
 src/Juvix/Core/Extra/Base.hs                | 32 ++++++++++++---------
 src/Juvix/Core/Language.hs                  | 14 +++++++++
 src/Juvix/Core/Language/Base.hs             | 16 +----------
 6 files changed, 40 insertions(+), 30 deletions(-)
 rename src/Juvix/Core/{Types => Data}/InfoTable.hs (97%)

diff --git a/src/Juvix/Core/Types/InfoTable.hs b/src/Juvix/Core/Data/InfoTable.hs
similarity index 97%
rename from src/Juvix/Core/Types/InfoTable.hs
rename to src/Juvix/Core/Data/InfoTable.hs
index 5eecff7340..15dc6c26a5 100644
--- a/src/Juvix/Core/Types/InfoTable.hs
+++ b/src/Juvix/Core/Data/InfoTable.hs
@@ -1,4 +1,4 @@
-module Juvix.Core.Types.InfoTable where
+module Juvix.Core.Data.InfoTable where
 
 import Juvix.Core.Language
 import Juvix.Core.Language.Type
diff --git a/src/Juvix/Core/Evaluator.hs b/src/Juvix/Core/Evaluator.hs
index c6e6140186..a52ac41bfb 100644
--- a/src/Juvix/Core/Evaluator.hs
+++ b/src/Juvix/Core/Evaluator.hs
@@ -12,7 +12,7 @@ import GHC.Show
 import Juvix.Core.Extra
 import Juvix.Core.Language
 import Juvix.Core.Language.Info qualified as Info
-import Juvix.Core.Types.InfoTable
+import Juvix.Core.Data.InfoTable
 
 newtype EvalError = EvalError String
 
diff --git a/src/Juvix/Core/Extra.hs b/src/Juvix/Core/Extra.hs
index f22612fa68..8d5fab13c4 100644
--- a/src/Juvix/Core/Extra.hs
+++ b/src/Juvix/Core/Extra.hs
@@ -9,6 +9,7 @@ import Data.HashSet qualified as HashSet
 import Juvix.Core.Extra.Base
 import Juvix.Core.Extra.Recursors
 import Juvix.Core.Language
+import Juvix.Core.Language.Info qualified as Info
 
 -- `isClosed` may short-circuit evaluation due to the use of `&&`, so it's not
 -- entirely reducible to `getFreeVars` in terms of computation time.
@@ -124,3 +125,6 @@ etaExpandConstrs argsNum = umap go
         | argsNum constrTag > length constrArgs ->
             etaExpand (argsNum constrTag - length constrArgs) n
       _ -> n
+
+removeInfo :: IsInfo i => Key i -> Node -> Node
+removeInfo k = umap (modifyInfo (Info.delete k))
diff --git a/src/Juvix/Core/Extra/Base.hs b/src/Juvix/Core/Extra/Base.hs
index 5978d406d2..d3bf0c990f 100644
--- a/src/Juvix/Core/Extra/Base.hs
+++ b/src/Juvix/Core/Extra/Base.hs
@@ -25,36 +25,42 @@ getArgs = snd . unfoldType
 {------------------------------------------------------------------------}
 {- functions on Node -}
 
-mkApp :: Node -> [(Info, Node)] -> Node
-mkApp = foldl' (\acc (i, n) -> App i acc n)
+mkApp' :: Node -> [(Info, Node)] -> Node
+mkApp' = foldl' (\acc (i, n) -> App i acc n)
 
-mkApp' :: Node -> [Node] -> Node
-mkApp' = foldl' (App Info.empty)
+mkApp :: Node -> [Node] -> Node
+mkApp = foldl' (App Info.empty)
 
-unfoldApp :: Node -> (Node, [(Info, Node)])
-unfoldApp = go []
+unfoldApp' :: Node -> (Node, [(Info, Node)])
+unfoldApp' = go []
   where
     go :: [(Info, Node)] -> Node -> (Node, [(Info, Node)])
     go acc n = case n of
       App i l r -> go ((i, r) : acc) l
       _ -> (n, acc)
 
-mkLambdas :: [Info] -> Node -> Node
-mkLambdas is n = foldr Lambda n is
+unfoldApp :: Node -> (Node, [Node])
+unfoldApp = second (map snd) . unfoldApp'
 
-mkLambdas' :: Int -> Node -> Node
-mkLambdas' k = mkLambdas (replicate k Info.empty)
+mkLambdas' :: [Info] -> Node -> Node
+mkLambdas' is n = foldr Lambda n is
 
-unfoldLambdas :: Node -> ([Info], Node)
-unfoldLambdas = go []
+mkLambdas :: Int -> Node -> Node
+mkLambdas k = mkLambdas' (replicate k Info.empty)
+
+unfoldLambdas' :: Node -> ([Info], Node)
+unfoldLambdas' = go []
   where
     go :: [Info] -> Node -> ([Info], Node)
     go acc n = case n of
       Lambda i b -> go (i : acc) b
       _ -> (acc, n)
 
+unfoldLambdas :: Node -> (Int, Node)
+unfoldLambdas = first length . unfoldLambdas'
+
 etaExpand :: Int -> Node -> Node
-etaExpand k n = mkLambdas' k (mkApp' n (map (Var Info.empty) [0 .. k - 1]))
+etaExpand k n = mkLambdas k (mkApp n (map (Var Info.empty) [0 .. k - 1]))
 
 -- `NodeDetails` is a convenience datatype which provides the most commonly needed
 -- information about a node in a generic fashion.
diff --git a/src/Juvix/Core/Language.hs b/src/Juvix/Core/Language.hs
index bdbff7e7e1..08741fa57b 100644
--- a/src/Juvix/Core/Language.hs
+++ b/src/Juvix/Core/Language.hs
@@ -5,6 +5,7 @@
 
 module Juvix.Core.Language
   ( module Juvix.Core.Language,
+    module Juvix.Core.Language.Builtins,
     module Juvix.Core.Language.Base,
   )
 where
@@ -14,10 +15,23 @@ where
 -}
 
 import Juvix.Core.Language.Base
+import Juvix.Core.Language.Builtins
 
 {---------------------------------------------------------------------------------}
 {- Program tree datatype -}
 
+-- Consecutive symbol IDs for reachable user functions.
+type Symbol = Word
+
+-- Tag of a constructor, uniquely identifying it. Tag values are consecutive and
+-- separate from symbol IDs. We might need fixed special tags in Core for common
+-- "builtin" constructors, e.g., unit, nat, lists, pairs, so that the code
+-- generator can treat them specially.
+data Tag = BuiltinTag BuiltinDataTag | UserTag Word
+  deriving stock (Eq, Generic)
+
+instance Hashable Tag
+
 -- de Bruijn index
 type Index = Int
 
diff --git a/src/Juvix/Core/Language/Base.hs b/src/Juvix/Core/Language/Base.hs
index 4918f750a6..87678189c4 100644
--- a/src/Juvix/Core/Language/Base.hs
+++ b/src/Juvix/Core/Language/Base.hs
@@ -2,30 +2,16 @@ module Juvix.Core.Language.Base
   ( Info,
     Key,
     IsInfo,
-    module Juvix.Core.Language.Base,
-    module Juvix.Core.Language.Builtins,
     module Juvix.Prelude,
     module Juvix.Prelude.Loc,
     module Juvix.Syntax.Abstract.Name,
+    Location,
   )
 where
 
-import Juvix.Core.Language.Builtins
 import Juvix.Core.Language.Info (Info, IsInfo, Key)
 import Juvix.Prelude
 import Juvix.Prelude.Loc
 import Juvix.Syntax.Abstract.Name
 
 type Location = Interval
-
--- Consecutive symbol IDs for reachable user functions.
-type Symbol = Word
-
--- Tag of a constructor, uniquely identifying it. Tag values are consecutive and
--- separate from symbol IDs. We might need fixed special tags in Core for common
--- "builtin" constructors, e.g., unit, nat, lists, pairs, so that the code
--- generator can treat them specially.
-data Tag = BuiltinTag BuiltinDataTag | UserTag Word
-  deriving stock (Eq, Generic)
-
-instance Hashable Tag

From 17d794e85fdd98755d8fc2b0e22c14e674a48734 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Wed, 3 Aug 2022 09:33:20 +0200
Subject: [PATCH 28/85] make ormolu happy

---
 src/Juvix/Core/Evaluator.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Juvix/Core/Evaluator.hs b/src/Juvix/Core/Evaluator.hs
index a52ac41bfb..3e298ec391 100644
--- a/src/Juvix/Core/Evaluator.hs
+++ b/src/Juvix/Core/Evaluator.hs
@@ -9,10 +9,10 @@ module Juvix.Core.Evaluator where
 import Control.Exception qualified as Exception
 import Data.HashMap.Strict ((!))
 import GHC.Show
+import Juvix.Core.Data.InfoTable
 import Juvix.Core.Extra
 import Juvix.Core.Language
 import Juvix.Core.Language.Info qualified as Info
-import Juvix.Core.Data.InfoTable
 
 newtype EvalError = EvalError String
 

From 45ba1cea2dd438d81cf446088cdcebfdc2802de0 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Wed, 3 Aug 2022 09:39:44 +0200
Subject: [PATCH 29/85] refactor

---
 src/Juvix/Core/Language.hs      | 14 --------------
 src/Juvix/Core/Language/Base.hs | 16 ++++++++++++++++
 2 files changed, 16 insertions(+), 14 deletions(-)

diff --git a/src/Juvix/Core/Language.hs b/src/Juvix/Core/Language.hs
index 08741fa57b..bdbff7e7e1 100644
--- a/src/Juvix/Core/Language.hs
+++ b/src/Juvix/Core/Language.hs
@@ -5,7 +5,6 @@
 
 module Juvix.Core.Language
   ( module Juvix.Core.Language,
-    module Juvix.Core.Language.Builtins,
     module Juvix.Core.Language.Base,
   )
 where
@@ -15,23 +14,10 @@ where
 -}
 
 import Juvix.Core.Language.Base
-import Juvix.Core.Language.Builtins
 
 {---------------------------------------------------------------------------------}
 {- Program tree datatype -}
 
--- Consecutive symbol IDs for reachable user functions.
-type Symbol = Word
-
--- Tag of a constructor, uniquely identifying it. Tag values are consecutive and
--- separate from symbol IDs. We might need fixed special tags in Core for common
--- "builtin" constructors, e.g., unit, nat, lists, pairs, so that the code
--- generator can treat them specially.
-data Tag = BuiltinTag BuiltinDataTag | UserTag Word
-  deriving stock (Eq, Generic)
-
-instance Hashable Tag
-
 -- de Bruijn index
 type Index = Int
 
diff --git a/src/Juvix/Core/Language/Base.hs b/src/Juvix/Core/Language/Base.hs
index 87678189c4..fb8368e5d4 100644
--- a/src/Juvix/Core/Language/Base.hs
+++ b/src/Juvix/Core/Language/Base.hs
@@ -2,16 +2,32 @@ module Juvix.Core.Language.Base
   ( Info,
     Key,
     IsInfo,
+    module Juvix.Core.Language.Builtins,
     module Juvix.Prelude,
     module Juvix.Prelude.Loc,
     module Juvix.Syntax.Abstract.Name,
     Location,
+    Symbol,
+    Tag,
   )
 where
 
+import Juvix.Core.Language.Builtins
 import Juvix.Core.Language.Info (Info, IsInfo, Key)
 import Juvix.Prelude
 import Juvix.Prelude.Loc
 import Juvix.Syntax.Abstract.Name
 
 type Location = Interval
+
+-- Consecutive symbol IDs for reachable user functions.
+type Symbol = Word
+
+-- Tag of a constructor, uniquely identifying it. Tag values are consecutive and
+-- separate from symbol IDs. We might need fixed special tags in Core for common
+-- "builtin" constructors, e.g., unit, nat, lists, pairs, so that the code
+-- generator can treat them specially.
+data Tag = BuiltinTag BuiltinDataTag | UserTag Word
+  deriving stock (Eq, Generic)
+
+instance Hashable Tag

From ac164837969644e08ce9b706f1633071c18ce7df Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Wed, 3 Aug 2022 12:38:13 +0200
Subject: [PATCH 30/85] BinderList

---
 src/Juvix/Core/Data/BinderList.hs | 45 +++++++++++++++++++++++++++++++
 src/Juvix/Core/Extra/Recursors.hs | 30 ++++++++++++---------
 src/Juvix/Core/Language.hs        | 11 +++++---
 src/Juvix/Core/Language/Base.hs   |  4 +++
 4 files changed, 74 insertions(+), 16 deletions(-)
 create mode 100644 src/Juvix/Core/Data/BinderList.hs

diff --git a/src/Juvix/Core/Data/BinderList.hs b/src/Juvix/Core/Data/BinderList.hs
new file mode 100644
index 0000000000..957406b758
--- /dev/null
+++ b/src/Juvix/Core/Data/BinderList.hs
@@ -0,0 +1,45 @@
+module Juvix.Core.Data.BinderList where
+
+import Data.HashMap.Strict qualified as HashMap
+import Data.List qualified as List
+import Juvix.Core.Language.Base
+
+data BinderList a = BinderList
+  { _blLength :: Int,
+    _blMap :: HashMap Index a
+  }
+
+makeLenses ''BinderList
+
+fromList :: [a] -> BinderList a
+fromList l = BinderList (List.length l) (HashMap.fromList (zip [0 ..] l))
+
+toList :: BinderList a -> [a]
+toList bl =
+  List.map snd $
+    sortBy (\x y -> compare (fst y) (fst x)) $
+      HashMap.toList (bl ^. blMap)
+
+empty :: BinderList a
+empty = BinderList 0 mempty
+
+length :: BinderList a -> Int
+length = (^. blLength)
+
+lookup :: Index -> BinderList a -> a
+lookup idx bl =
+  fromMaybe
+    (error "invalid binder lookup")
+    (HashMap.lookup (bl ^. blLength - 1 - idx) (bl ^. blMap))
+
+extend :: a -> BinderList a -> BinderList a
+extend a bl =
+  BinderList
+    (bl ^. blLength + 1)
+    (HashMap.insert (bl ^. blLength) a (bl ^. blMap))
+
+map :: (a -> b) -> BinderList a -> BinderList b
+map f bl = bl{_blMap = HashMap.map f (bl ^. blMap)}
+
+prepend :: [a] -> BinderList a -> BinderList a
+prepend l bl = foldr extend bl l
diff --git a/src/Juvix/Core/Extra/Recursors.hs b/src/Juvix/Core/Extra/Recursors.hs
index b03e2f9b80..eac16957d7 100644
--- a/src/Juvix/Core/Extra/Recursors.hs
+++ b/src/Juvix/Core/Extra/Recursors.hs
@@ -1,6 +1,12 @@
-module Juvix.Core.Extra.Recursors where
+module Juvix.Core.Extra.Recursors
+  ( module Juvix.Core.Extra.Recursors,
+    BinderList,
+  )
+where
 
 import Data.Functor.Identity
+import Juvix.Core.Data.BinderList (BinderList)
+import Juvix.Core.Data.BinderList qualified as BL
 import Juvix.Core.Extra.Base
 import Juvix.Core.Language
 import Juvix.Core.Language.Info.BinderInfo
@@ -20,11 +26,11 @@ makeLenses ''Collector
 unitCollector :: Collector a ()
 unitCollector = Collector () (\_ _ -> ())
 
-binderInfoCollector :: Collector (Int, Maybe [BinderInfo]) [Maybe BinderInfo]
+binderInfoCollector :: Collector (Int, Maybe [BinderInfo]) (BinderList (Maybe BinderInfo))
 binderInfoCollector =
   Collector
-    []
-    (\(k, bi) c -> if k == 0 then c else map Just (fromJust bi) ++ c)
+    BL.empty
+    (\(k, bi) c -> if k == 0 then c else BL.prepend (map Just (fromJust bi)) c)
 
 binderNumCollector :: Collector (Int, Maybe [BinderInfo]) Index
 binderNumCollector = Collector 0 (\(k, _) c -> c + k)
@@ -56,7 +62,7 @@ umapG coll f = go (coll ^. cEmpty)
 umapM :: Monad m => (Node -> m Node) -> Node -> m Node
 umapM f = umapG unitCollector (const f)
 
-umapMB :: Monad m => ([Maybe BinderInfo] -> Node -> m Node) -> Node -> m Node
+umapMB :: Monad m => (BinderList (Maybe BinderInfo) -> Node -> m Node) -> Node -> m Node
 umapMB f = umapG binderInfoCollector f
 
 umapMN :: Monad m => (Index -> Node -> m Node) -> Node -> m Node
@@ -65,7 +71,7 @@ umapMN f = umapG binderNumCollector f
 umap :: (Node -> Node) -> Node -> Node
 umap f n = runIdentity $ umapM (return . f) n
 
-umapB :: ([Maybe BinderInfo] -> Node -> Node) -> Node -> Node
+umapB :: (BinderList (Maybe BinderInfo) -> Node -> Node) -> Node -> Node
 umapB f n = runIdentity $ umapMB (\is -> return . f is) n
 
 umapN :: (Index -> Node -> Node) -> Node -> Node
@@ -97,7 +103,7 @@ dmapG coll f = go (coll ^. cEmpty)
 dmapM :: Monad m => (Node -> m Node) -> Node -> m Node
 dmapM f = dmapG unitCollector (const f)
 
-dmapMB :: Monad m => ([Maybe BinderInfo] -> Node -> m Node) -> Node -> m Node
+dmapMB :: Monad m => (BinderList (Maybe BinderInfo) -> Node -> m Node) -> Node -> m Node
 dmapMB f = dmapG binderInfoCollector f
 
 dmapMN :: Monad m => (Index -> Node -> m Node) -> Node -> m Node
@@ -106,7 +112,7 @@ dmapMN f = dmapG binderNumCollector f
 dmap :: (Node -> Node) -> Node -> Node
 dmap f n = runIdentity $ dmapM (return . f) n
 
-dmapB :: ([Maybe BinderInfo] -> Node -> Node) -> Node -> Node
+dmapB :: (BinderList (Maybe BinderInfo) -> Node -> Node) -> Node -> Node
 dmapB f n = runIdentity $ dmapMB (\is -> return . f is) n
 
 dmapN :: (Index -> Node -> Node) -> Node -> Node
@@ -140,7 +146,7 @@ ufoldG coll uplus f = go (coll ^. cEmpty)
 ufoldM :: Monad m => (a -> a -> a) -> (Node -> m a) -> Node -> m a
 ufoldM uplus f = ufoldG unitCollector uplus (const f)
 
-ufoldMB :: Monad m => (a -> a -> a) -> ([Maybe BinderInfo] -> Node -> m a) -> Node -> m a
+ufoldMB :: Monad m => (a -> a -> a) -> (BinderList (Maybe BinderInfo) -> Node -> m a) -> Node -> m a
 ufoldMB uplus f = ufoldG binderInfoCollector uplus f
 
 ufoldMN :: Monad m => (a -> a -> a) -> (Index -> Node -> m a) -> Node -> m a
@@ -149,7 +155,7 @@ ufoldMN uplus f = ufoldG binderNumCollector uplus f
 ufold :: (a -> a -> a) -> (Node -> a) -> Node -> a
 ufold uplus f n = runIdentity $ ufoldM uplus (return . f) n
 
-ufoldB :: (a -> a -> a) -> ([Maybe BinderInfo] -> Node -> a) -> Node -> a
+ufoldB :: (a -> a -> a) -> (BinderList (Maybe BinderInfo) -> Node -> a) -> Node -> a
 ufoldB uplus f n = runIdentity $ ufoldMB uplus (\is -> return . f is) n
 
 ufoldN :: (a -> a -> a) -> (Index -> Node -> a) -> Node -> a
@@ -158,7 +164,7 @@ ufoldN uplus f n = runIdentity $ ufoldMN uplus (\idx -> return . f idx) n
 walk :: Monad m => (Node -> m ()) -> Node -> m ()
 walk = ufoldM mappend
 
-walkB :: Monad m => ([Maybe BinderInfo] -> Node -> m ()) -> Node -> m ()
+walkB :: Monad m => (BinderList (Maybe BinderInfo) -> Node -> m ()) -> Node -> m ()
 walkB = ufoldMB mappend
 
 walkN :: Monad m => (Index -> Node -> m ()) -> Node -> m ()
@@ -167,7 +173,7 @@ walkN = ufoldMN mappend
 gather :: (a -> Node -> a) -> a -> Node -> a
 gather f acc n = run $ execState acc (walk (\n' -> modify (`f` n')) n)
 
-gatherB :: ([Maybe BinderInfo] -> a -> Node -> a) -> a -> Node -> a
+gatherB :: (BinderList (Maybe BinderInfo) -> a -> Node -> a) -> a -> Node -> a
 gatherB f acc n = run $ execState acc (walkB (\is n' -> modify (\a -> f is a n')) n)
 
 gatherN :: (Index -> a -> Node -> a) -> a -> Node -> a
diff --git a/src/Juvix/Core/Language.hs b/src/Juvix/Core/Language.hs
index bdbff7e7e1..f11a49aa4e 100644
--- a/src/Juvix/Core/Language.hs
+++ b/src/Juvix/Core/Language.hs
@@ -18,9 +18,6 @@ import Juvix.Core.Language.Base
 {---------------------------------------------------------------------------------}
 {- Program tree datatype -}
 
--- de Bruijn index
-type Index = Int
-
 -- `Node` is the type of nodes in the program tree. The nodes themselves
 -- contain only runtime-relevant information. Runtime-irrelevant annotations
 -- (including all type information) are stored in the infos associated with each
@@ -118,5 +115,11 @@ data CaseBranch = CaseBranch {caseTag :: !Tag, caseBindersNum :: !Int, caseBranc
 -- Whether something is a value matters only for evaluation semantics. It
 -- doesn't matter much outside the evaluator.
 
--- all nodes in an environment must be values
+-- All nodes in an environment must be values.
+--
+-- Strictly speaking, representing the environment by a list may result in
+-- quadratic complexity in the evaluator if there are many binders. However,
+-- this is typically the fastest way in practice. If this ever becomes an issue,
+-- we can change Env to use Core.Data.BinderList which has O(1) lookup
+-- complexity but larger constant factor.
 type Env = [Node]
diff --git a/src/Juvix/Core/Language/Base.hs b/src/Juvix/Core/Language/Base.hs
index fb8368e5d4..b18398526d 100644
--- a/src/Juvix/Core/Language/Base.hs
+++ b/src/Juvix/Core/Language/Base.hs
@@ -9,6 +9,7 @@ module Juvix.Core.Language.Base
     Location,
     Symbol,
     Tag,
+    Index,
   )
 where
 
@@ -31,3 +32,6 @@ data Tag = BuiltinTag BuiltinDataTag | UserTag Word
   deriving stock (Eq, Generic)
 
 instance Hashable Tag
+
+-- de Bruijn index
+type Index = Int

From 54c3c01815f1cd279bbc38acf9882ae47e7dfc5c Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Wed, 3 Aug 2022 12:56:51 +0200
Subject: [PATCH 31/85] ArgsNumInfo

---
 src/Juvix/Core/Data/BinderList.hs           |  2 +-
 src/Juvix/Core/Extra.hs                     |  5 ++++-
 src/Juvix/Core/Language/Info.hs             |  2 +-
 src/Juvix/Core/Language/Info/ArgsNumInfo.hs | 14 ++++++++++++++
 4 files changed, 20 insertions(+), 3 deletions(-)
 create mode 100644 src/Juvix/Core/Language/Info/ArgsNumInfo.hs

diff --git a/src/Juvix/Core/Data/BinderList.hs b/src/Juvix/Core/Data/BinderList.hs
index 957406b758..c6e8fce06d 100644
--- a/src/Juvix/Core/Data/BinderList.hs
+++ b/src/Juvix/Core/Data/BinderList.hs
@@ -39,7 +39,7 @@ extend a bl =
     (HashMap.insert (bl ^. blLength) a (bl ^. blMap))
 
 map :: (a -> b) -> BinderList a -> BinderList b
-map f bl = bl{_blMap = HashMap.map f (bl ^. blMap)}
+map f bl = bl {_blMap = HashMap.map f (bl ^. blMap)}
 
 prepend :: [a] -> BinderList a -> BinderList a
 prepend l bl = foldr extend bl l
diff --git a/src/Juvix/Core/Extra.hs b/src/Juvix/Core/Extra.hs
index 8d5fab13c4..dc057ac6b5 100644
--- a/src/Juvix/Core/Extra.hs
+++ b/src/Juvix/Core/Extra.hs
@@ -126,5 +126,8 @@ etaExpandConstrs argsNum = umap go
             etaExpand (argsNum constrTag - length constrArgs) n
       _ -> n
 
+mapInfo :: (Info -> Info) -> Node -> Node
+mapInfo f = umap (modifyInfo f)
+
 removeInfo :: IsInfo i => Key i -> Node -> Node
-removeInfo k = umap (modifyInfo (Info.delete k))
+removeInfo k = mapInfo (Info.delete k)
diff --git a/src/Juvix/Core/Language/Info.hs b/src/Juvix/Core/Language/Info.hs
index 57bdd2e20f..e811757824 100644
--- a/src/Juvix/Core/Language/Info.hs
+++ b/src/Juvix/Core/Language/Info.hs
@@ -22,7 +22,7 @@ makeLenses ''Info
 empty :: Info
 empty = Info HashMap.empty
 
-member :: IsInfo a => Key a -> Info -> Bool
+member :: forall a. IsInfo a => Key a -> Info -> Bool
 member k i = HashMap.member (typeRep k) (i ^. infoMap)
 
 lookup :: IsInfo a => Key a -> Info -> Maybe a
diff --git a/src/Juvix/Core/Language/Info/ArgsNumInfo.hs b/src/Juvix/Core/Language/Info/ArgsNumInfo.hs
new file mode 100644
index 0000000000..6a6fee5f89
--- /dev/null
+++ b/src/Juvix/Core/Language/Info/ArgsNumInfo.hs
@@ -0,0 +1,14 @@
+module Juvix.Core.Language.Info.ArgsNumInfo where
+
+import Juvix.Core.Language.Base
+
+newtype ArgsNumInfo = ArgsNumInfo
+  { _infoArgsNum :: Int
+  }
+
+instance IsInfo ArgsNumInfo
+
+kArgsNumInfo :: Key ArgsNumInfo
+kArgsNumInfo = Proxy
+
+makeLenses ''ArgsNumInfo

From 0dfc8582344fea9b82e5de2238aac0315f5c913c Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Wed, 3 Aug 2022 13:00:30 +0200
Subject: [PATCH 32/85] refactor InfoTable

---
 src/Juvix/Core/Data/InfoTable.hs | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/src/Juvix/Core/Data/InfoTable.hs b/src/Juvix/Core/Data/InfoTable.hs
index 15dc6c26a5..aaceb67e8a 100644
--- a/src/Juvix/Core/Data/InfoTable.hs
+++ b/src/Juvix/Core/Data/InfoTable.hs
@@ -7,10 +7,10 @@ type IdentContext = HashMap Symbol Node
 
 data InfoTable = InfoTable
   { _identContext :: IdentContext,
-    _identInfo :: HashMap Symbol IdentInfo,
-    _inductiveInfo :: HashMap Name InductiveInfo,
-    _constructorInfo :: HashMap Tag ConstructorInfo,
-    _axiomInfo :: HashMap Name AxiomInfo
+    _infoIdents :: HashMap Symbol IdentInfo,
+    _infoInductives :: HashMap Name InductiveInfo,
+    _infoConstructors :: HashMap Tag ConstructorInfo,
+    _infoAxioms :: HashMap Name AxiomInfo
   }
 
 data IdentInfo = IdentInfo
@@ -24,9 +24,9 @@ data IdentInfo = IdentInfo
   }
 
 data ArgumentInfo = ArgumentInfo
-  { _argName :: Name,
-    _argType :: Type,
-    _argIsImplicit :: Bool
+  { _argumentName :: Name,
+    _argumentType :: Type,
+    _argumentIsImplicit :: Bool
   }
 
 data InductiveInfo = InductiveInfo

From 132654400bb5b5e3440705de2ad0a07a3a4c5916 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Wed, 3 Aug 2022 18:44:01 +0200
Subject: [PATCH 33/85] remove stupid comment

---
 src/Juvix/Core/Language.hs | 6 ------
 1 file changed, 6 deletions(-)

diff --git a/src/Juvix/Core/Language.hs b/src/Juvix/Core/Language.hs
index f11a49aa4e..4efd0eb8e4 100644
--- a/src/Juvix/Core/Language.hs
+++ b/src/Juvix/Core/Language.hs
@@ -116,10 +116,4 @@ data CaseBranch = CaseBranch {caseTag :: !Tag, caseBindersNum :: !Int, caseBranc
 -- doesn't matter much outside the evaluator.
 
 -- All nodes in an environment must be values.
---
--- Strictly speaking, representing the environment by a list may result in
--- quadratic complexity in the evaluator if there are many binders. However,
--- this is typically the fastest way in practice. If this ever becomes an issue,
--- we can change Env to use Core.Data.BinderList which has O(1) lookup
--- complexity but larger constant factor.
 type Env = [Node]

From d0f3b394f4c840083128ac3bbafa644cacac3c1a Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Wed, 3 Aug 2022 18:56:50 +0200
Subject: [PATCH 34/85] refactor for PR #1420

---
 src/Juvix/{ => Compiler}/Core/Data/BinderList.hs |  4 ++--
 src/Juvix/{ => Compiler}/Core/Data/InfoTable.hs  |  6 +++---
 src/Juvix/{ => Compiler}/Core/Evaluator.hs       | 10 +++++-----
 src/Juvix/{ => Compiler}/Core/Extra.hs           | 16 ++++++++--------
 src/Juvix/{ => Compiler}/Core/Extra/Base.hs      | 10 +++++-----
 src/Juvix/{ => Compiler}/Core/Extra/Recursors.hs | 14 +++++++-------
 src/Juvix/{ => Compiler}/Core/Language.hs        |  8 ++++----
 src/Juvix/{ => Compiler}/Core/Language/Base.hs   | 14 ++++++--------
 .../{ => Compiler}/Core/Language/Builtins.hs     |  2 +-
 src/Juvix/{ => Compiler}/Core/Language/Info.hs   |  4 ++--
 .../Core/Language/Info/ArgsNumInfo.hs            |  4 ++--
 .../Core/Language/Info/BinderInfo.hs             |  6 +++---
 .../Core/Language/Info/FreeVarsInfo.hs           |  8 ++++----
 .../Core/Language/Info/IdentInfo.hs              |  8 ++++----
 .../Core/Language/Info/LocationInfo.hs           |  4 ++--
 .../Core/Language/Info/NameInfo.hs               |  4 ++--
 .../Core/Language/Info/TypeInfo.hs               |  6 +++---
 src/Juvix/{ => Compiler}/Core/Language/Type.hs   |  4 ++--
 18 files changed, 65 insertions(+), 67 deletions(-)
 rename src/Juvix/{ => Compiler}/Core/Data/BinderList.hs (92%)
 rename src/Juvix/{ => Compiler}/Core/Data/InfoTable.hs (91%)
 rename src/Juvix/{ => Compiler}/Core/Evaluator.hs (95%)
 rename src/Juvix/{ => Compiler}/Core/Extra.hs (90%)
 rename src/Juvix/{ => Compiler}/Core/Extra/Base.hs (96%)
 rename src/Juvix/{ => Compiler}/Core/Extra/Recursors.hs (94%)
 rename src/Juvix/{ => Compiler}/Core/Language.hs (96%)
 rename src/Juvix/{ => Compiler}/Core/Language/Base.hs (69%)
 rename src/Juvix/{ => Compiler}/Core/Language/Builtins.hs (94%)
 rename src/Juvix/{ => Compiler}/Core/Language/Info.hs (94%)
 rename src/Juvix/{ => Compiler}/Core/Language/Info/ArgsNumInfo.hs (63%)
 rename src/Juvix/{ => Compiler}/Core/Language/Info/BinderInfo.hs (73%)
 rename src/Juvix/{ => Compiler}/Core/Language/Info/FreeVarsInfo.hs (87%)
 rename src/Juvix/{ => Compiler}/Core/Language/Info/IdentInfo.hs (84%)
 rename src/Juvix/{ => Compiler}/Core/Language/Info/LocationInfo.hs (64%)
 rename src/Juvix/{ => Compiler}/Core/Language/Info/NameInfo.hs (59%)
 rename src/Juvix/{ => Compiler}/Core/Language/Info/TypeInfo.hs (51%)
 rename src/Juvix/{ => Compiler}/Core/Language/Type.hs (61%)

diff --git a/src/Juvix/Core/Data/BinderList.hs b/src/Juvix/Compiler/Core/Data/BinderList.hs
similarity index 92%
rename from src/Juvix/Core/Data/BinderList.hs
rename to src/Juvix/Compiler/Core/Data/BinderList.hs
index c6e8fce06d..703172eba2 100644
--- a/src/Juvix/Core/Data/BinderList.hs
+++ b/src/Juvix/Compiler/Core/Data/BinderList.hs
@@ -1,8 +1,8 @@
-module Juvix.Core.Data.BinderList where
+module Juvix.Compiler.Core.Data.BinderList where
 
 import Data.HashMap.Strict qualified as HashMap
 import Data.List qualified as List
-import Juvix.Core.Language.Base
+import Juvix.Compiler.Core.Language.Base
 
 data BinderList a = BinderList
   { _blLength :: Int,
diff --git a/src/Juvix/Core/Data/InfoTable.hs b/src/Juvix/Compiler/Core/Data/InfoTable.hs
similarity index 91%
rename from src/Juvix/Core/Data/InfoTable.hs
rename to src/Juvix/Compiler/Core/Data/InfoTable.hs
index aaceb67e8a..983a061042 100644
--- a/src/Juvix/Core/Data/InfoTable.hs
+++ b/src/Juvix/Compiler/Core/Data/InfoTable.hs
@@ -1,7 +1,7 @@
-module Juvix.Core.Data.InfoTable where
+module Juvix.Compiler.Core.Data.InfoTable where
 
-import Juvix.Core.Language
-import Juvix.Core.Language.Type
+import Juvix.Compiler.Core.Language
+import Juvix.Compiler.Core.Language.Type
 
 type IdentContext = HashMap Symbol Node
 
diff --git a/src/Juvix/Core/Evaluator.hs b/src/Juvix/Compiler/Core/Evaluator.hs
similarity index 95%
rename from src/Juvix/Core/Evaluator.hs
rename to src/Juvix/Compiler/Core/Evaluator.hs
index 3e298ec391..a185ef4d69 100644
--- a/src/Juvix/Core/Evaluator.hs
+++ b/src/Juvix/Compiler/Core/Evaluator.hs
@@ -4,15 +4,15 @@
 {-# HLINT ignore "Avoid restricted extensions" #-}
 {-# HLINT ignore "Avoid restricted flags" #-}
 
-module Juvix.Core.Evaluator where
+module Juvix.Compiler.Core.Evaluator where
 
 import Control.Exception qualified as Exception
 import Data.HashMap.Strict ((!))
 import GHC.Show
-import Juvix.Core.Data.InfoTable
-import Juvix.Core.Extra
-import Juvix.Core.Language
-import Juvix.Core.Language.Info qualified as Info
+import Juvix.Compiler.Core.Data.InfoTable
+import Juvix.Compiler.Core.Extra
+import Juvix.Compiler.Core.Language
+import Juvix.Compiler.Core.Language.Info qualified as Info
 
 newtype EvalError = EvalError String
 
diff --git a/src/Juvix/Core/Extra.hs b/src/Juvix/Compiler/Core/Extra.hs
similarity index 90%
rename from src/Juvix/Core/Extra.hs
rename to src/Juvix/Compiler/Core/Extra.hs
index dc057ac6b5..52ca3380e3 100644
--- a/src/Juvix/Core/Extra.hs
+++ b/src/Juvix/Compiler/Core/Extra.hs
@@ -1,15 +1,15 @@
-module Juvix.Core.Extra
-  ( module Juvix.Core.Extra,
-    module Juvix.Core.Extra.Base,
-    module Juvix.Core.Extra.Recursors,
+module Juvix.Compiler.Core.Extra
+  ( module Juvix.Compiler.Core.Extra,
+    module Juvix.Compiler.Core.Extra.Base,
+    module Juvix.Compiler.Core.Extra.Recursors,
   )
 where
 
 import Data.HashSet qualified as HashSet
-import Juvix.Core.Extra.Base
-import Juvix.Core.Extra.Recursors
-import Juvix.Core.Language
-import Juvix.Core.Language.Info qualified as Info
+import Juvix.Compiler.Core.Extra.Base
+import Juvix.Compiler.Core.Extra.Recursors
+import Juvix.Compiler.Core.Language
+import Juvix.Compiler.Core.Language.Info qualified as Info
 
 -- `isClosed` may short-circuit evaluation due to the use of `&&`, so it's not
 -- entirely reducible to `getFreeVars` in terms of computation time.
diff --git a/src/Juvix/Core/Extra/Base.hs b/src/Juvix/Compiler/Core/Extra/Base.hs
similarity index 96%
rename from src/Juvix/Core/Extra/Base.hs
rename to src/Juvix/Compiler/Core/Extra/Base.hs
index d3bf0c990f..bcce518c77 100644
--- a/src/Juvix/Core/Extra/Base.hs
+++ b/src/Juvix/Compiler/Core/Extra/Base.hs
@@ -1,11 +1,11 @@
-module Juvix.Core.Extra.Base where
+module Juvix.Compiler.Core.Extra.Base where
 
 import Data.Functor.Identity
 import Data.List qualified as List
-import Juvix.Core.Language
-import Juvix.Core.Language.Info qualified as Info
-import Juvix.Core.Language.Info.BinderInfo
-import Juvix.Core.Language.Type
+import Juvix.Compiler.Core.Language
+import Juvix.Compiler.Core.Language.Info qualified as Info
+import Juvix.Compiler.Core.Language.Info.BinderInfo
+import Juvix.Compiler.Core.Language.Type
 
 {------------------------------------------------------------------------}
 {- functions on Type -}
diff --git a/src/Juvix/Core/Extra/Recursors.hs b/src/Juvix/Compiler/Core/Extra/Recursors.hs
similarity index 94%
rename from src/Juvix/Core/Extra/Recursors.hs
rename to src/Juvix/Compiler/Core/Extra/Recursors.hs
index eac16957d7..2545148248 100644
--- a/src/Juvix/Core/Extra/Recursors.hs
+++ b/src/Juvix/Compiler/Core/Extra/Recursors.hs
@@ -1,15 +1,15 @@
-module Juvix.Core.Extra.Recursors
-  ( module Juvix.Core.Extra.Recursors,
+module Juvix.Compiler.Core.Extra.Recursors
+  ( module Juvix.Compiler.Core.Extra.Recursors,
     BinderList,
   )
 where
 
 import Data.Functor.Identity
-import Juvix.Core.Data.BinderList (BinderList)
-import Juvix.Core.Data.BinderList qualified as BL
-import Juvix.Core.Extra.Base
-import Juvix.Core.Language
-import Juvix.Core.Language.Info.BinderInfo
+import Juvix.Compiler.Core.Data.BinderList (BinderList)
+import Juvix.Compiler.Core.Data.BinderList qualified as BL
+import Juvix.Compiler.Core.Extra.Base
+import Juvix.Compiler.Core.Language
+import Juvix.Compiler.Core.Language.Info.BinderInfo
 
 {---------------------------------------------------------------------------------}
 {- General recursors on Node  -}
diff --git a/src/Juvix/Core/Language.hs b/src/Juvix/Compiler/Core/Language.hs
similarity index 96%
rename from src/Juvix/Core/Language.hs
rename to src/Juvix/Compiler/Core/Language.hs
index 4efd0eb8e4..4529fba720 100644
--- a/src/Juvix/Core/Language.hs
+++ b/src/Juvix/Compiler/Core/Language.hs
@@ -3,9 +3,9 @@
 
 {-# HLINT ignore "Avoid restricted flags" #-}
 
-module Juvix.Core.Language
-  ( module Juvix.Core.Language,
-    module Juvix.Core.Language.Base,
+module Juvix.Compiler.Core.Language
+  ( module Juvix.Compiler.Core.Language,
+    module Juvix.Compiler.Core.Language.Base,
   )
 where
 
@@ -13,7 +13,7 @@ where
   This file defines the tree representation of JuvixCore (Node datatype).
 -}
 
-import Juvix.Core.Language.Base
+import Juvix.Compiler.Core.Language.Base
 
 {---------------------------------------------------------------------------------}
 {- Program tree datatype -}
diff --git a/src/Juvix/Core/Language/Base.hs b/src/Juvix/Compiler/Core/Language/Base.hs
similarity index 69%
rename from src/Juvix/Core/Language/Base.hs
rename to src/Juvix/Compiler/Core/Language/Base.hs
index b18398526d..91befc6461 100644
--- a/src/Juvix/Core/Language/Base.hs
+++ b/src/Juvix/Compiler/Core/Language/Base.hs
@@ -1,11 +1,10 @@
-module Juvix.Core.Language.Base
+module Juvix.Compiler.Core.Language.Base
   ( Info,
     Key,
     IsInfo,
-    module Juvix.Core.Language.Builtins,
+    module Juvix.Compiler.Core.Language.Builtins,
     module Juvix.Prelude,
-    module Juvix.Prelude.Loc,
-    module Juvix.Syntax.Abstract.Name,
+    module Juvix.Compiler.Abstract.Data.Name,
     Location,
     Symbol,
     Tag,
@@ -13,11 +12,10 @@ module Juvix.Core.Language.Base
   )
 where
 
-import Juvix.Core.Language.Builtins
-import Juvix.Core.Language.Info (Info, IsInfo, Key)
+import Juvix.Compiler.Abstract.Data.Name
+import Juvix.Compiler.Core.Language.Builtins
+import Juvix.Compiler.Core.Language.Info (Info, IsInfo, Key)
 import Juvix.Prelude
-import Juvix.Prelude.Loc
-import Juvix.Syntax.Abstract.Name
 
 type Location = Interval
 
diff --git a/src/Juvix/Core/Language/Builtins.hs b/src/Juvix/Compiler/Core/Language/Builtins.hs
similarity index 94%
rename from src/Juvix/Core/Language/Builtins.hs
rename to src/Juvix/Compiler/Core/Language/Builtins.hs
index 1ae6631765..2900c16ddb 100644
--- a/src/Juvix/Core/Language/Builtins.hs
+++ b/src/Juvix/Compiler/Core/Language/Builtins.hs
@@ -1,4 +1,4 @@
-module Juvix.Core.Language.Builtins where
+module Juvix.Compiler.Core.Language.Builtins where
 
 import Juvix.Prelude
 
diff --git a/src/Juvix/Core/Language/Info.hs b/src/Juvix/Compiler/Core/Language/Info.hs
similarity index 94%
rename from src/Juvix/Core/Language/Info.hs
rename to src/Juvix/Compiler/Core/Language/Info.hs
index e811757824..b0cc32d46f 100644
--- a/src/Juvix/Core/Language/Info.hs
+++ b/src/Juvix/Compiler/Core/Language/Info.hs
@@ -1,4 +1,4 @@
-module Juvix.Core.Language.Info where
+module Juvix.Compiler.Core.Language.Info where
 
 {-
   This file defines Infos stored in JuvixCore Nodes. The Info data structure
@@ -35,7 +35,7 @@ lookupDefault a i =
   fromDyn (HashMap.lookupDefault (toDyn a) (typeOf a) (i ^. infoMap)) impossible
 
 (!) :: IsInfo a => Key a -> Info -> a
-(!) k i = fromJust (Juvix.Core.Language.Info.lookup k i)
+(!) k i = fromJust (Juvix.Compiler.Core.Language.Info.lookup k i)
 
 insert :: IsInfo a => a -> Info -> Info
 insert a i = Info (HashMap.insert (typeOf a) (toDyn a) (i ^. infoMap))
diff --git a/src/Juvix/Core/Language/Info/ArgsNumInfo.hs b/src/Juvix/Compiler/Core/Language/Info/ArgsNumInfo.hs
similarity index 63%
rename from src/Juvix/Core/Language/Info/ArgsNumInfo.hs
rename to src/Juvix/Compiler/Core/Language/Info/ArgsNumInfo.hs
index 6a6fee5f89..81914832b2 100644
--- a/src/Juvix/Core/Language/Info/ArgsNumInfo.hs
+++ b/src/Juvix/Compiler/Core/Language/Info/ArgsNumInfo.hs
@@ -1,6 +1,6 @@
-module Juvix.Core.Language.Info.ArgsNumInfo where
+module Juvix.Compiler.Core.Language.Info.ArgsNumInfo where
 
-import Juvix.Core.Language.Base
+import Juvix.Compiler.Core.Language.Base
 
 newtype ArgsNumInfo = ArgsNumInfo
   { _infoArgsNum :: Int
diff --git a/src/Juvix/Core/Language/Info/BinderInfo.hs b/src/Juvix/Compiler/Core/Language/Info/BinderInfo.hs
similarity index 73%
rename from src/Juvix/Core/Language/Info/BinderInfo.hs
rename to src/Juvix/Compiler/Core/Language/Info/BinderInfo.hs
index 546b288850..2810d177b3 100644
--- a/src/Juvix/Core/Language/Info/BinderInfo.hs
+++ b/src/Juvix/Compiler/Core/Language/Info/BinderInfo.hs
@@ -1,7 +1,7 @@
-module Juvix.Core.Language.Info.BinderInfo where
+module Juvix.Compiler.Core.Language.Info.BinderInfo where
 
-import Juvix.Core.Language.Base
-import Juvix.Core.Language.Type
+import Juvix.Compiler.Core.Language.Base
+import Juvix.Compiler.Core.Language.Type
 
 data BinderInfo = BinderInfo
   { _infoName :: Name,
diff --git a/src/Juvix/Core/Language/Info/FreeVarsInfo.hs b/src/Juvix/Compiler/Core/Language/Info/FreeVarsInfo.hs
similarity index 87%
rename from src/Juvix/Core/Language/Info/FreeVarsInfo.hs
rename to src/Juvix/Compiler/Core/Language/Info/FreeVarsInfo.hs
index d4733affbc..653817e83e 100644
--- a/src/Juvix/Core/Language/Info/FreeVarsInfo.hs
+++ b/src/Juvix/Compiler/Core/Language/Info/FreeVarsInfo.hs
@@ -1,9 +1,9 @@
-module Juvix.Core.Language.Info.FreeVarsInfo where
+module Juvix.Compiler.Core.Language.Info.FreeVarsInfo where
 
 import Data.HashMap.Strict qualified as HashMap
-import Juvix.Core.Extra
-import Juvix.Core.Language
-import Juvix.Core.Language.Info qualified as Info
+import Juvix.Compiler.Core.Extra
+import Juvix.Compiler.Core.Language
+import Juvix.Compiler.Core.Language.Info qualified as Info
 
 newtype FreeVarsInfo = FreeVarsInfo
   { -- map free variables to the number of their occurrences
diff --git a/src/Juvix/Core/Language/Info/IdentInfo.hs b/src/Juvix/Compiler/Core/Language/Info/IdentInfo.hs
similarity index 84%
rename from src/Juvix/Core/Language/Info/IdentInfo.hs
rename to src/Juvix/Compiler/Core/Language/Info/IdentInfo.hs
index 7520aaa75e..6404b0bff2 100644
--- a/src/Juvix/Core/Language/Info/IdentInfo.hs
+++ b/src/Juvix/Compiler/Core/Language/Info/IdentInfo.hs
@@ -1,9 +1,9 @@
-module Juvix.Core.Language.Info.IdentInfo where
+module Juvix.Compiler.Core.Language.Info.IdentInfo where
 
 import Data.HashMap.Strict qualified as HashMap
-import Juvix.Core.Extra
-import Juvix.Core.Language
-import Juvix.Core.Language.Info qualified as Info
+import Juvix.Compiler.Core.Extra
+import Juvix.Compiler.Core.Language
+import Juvix.Compiler.Core.Language.Info qualified as Info
 
 newtype IdentInfo = IdentInfo
   { -- map symbols to the number of their occurrences
diff --git a/src/Juvix/Core/Language/Info/LocationInfo.hs b/src/Juvix/Compiler/Core/Language/Info/LocationInfo.hs
similarity index 64%
rename from src/Juvix/Core/Language/Info/LocationInfo.hs
rename to src/Juvix/Compiler/Core/Language/Info/LocationInfo.hs
index 1a48b4616a..bd5a9da75b 100644
--- a/src/Juvix/Core/Language/Info/LocationInfo.hs
+++ b/src/Juvix/Compiler/Core/Language/Info/LocationInfo.hs
@@ -1,6 +1,6 @@
-module Juvix.Core.Language.Info.LocationInfo where
+module Juvix.Compiler.Core.Language.Info.LocationInfo where
 
-import Juvix.Core.Language.Base
+import Juvix.Compiler.Core.Language.Base
 
 newtype LocationInfo = LocationInfo {_infoLocation :: Location}
 
diff --git a/src/Juvix/Core/Language/Info/NameInfo.hs b/src/Juvix/Compiler/Core/Language/Info/NameInfo.hs
similarity index 59%
rename from src/Juvix/Core/Language/Info/NameInfo.hs
rename to src/Juvix/Compiler/Core/Language/Info/NameInfo.hs
index ad07d56ac5..0e444a2551 100644
--- a/src/Juvix/Core/Language/Info/NameInfo.hs
+++ b/src/Juvix/Compiler/Core/Language/Info/NameInfo.hs
@@ -1,6 +1,6 @@
-module Juvix.Core.Language.Info.NameInfo where
+module Juvix.Compiler.Core.Language.Info.NameInfo where
 
-import Juvix.Core.Language.Base
+import Juvix.Compiler.Core.Language.Base
 
 newtype NameInfo = NameInfo {_infoName :: Name}
 
diff --git a/src/Juvix/Core/Language/Info/TypeInfo.hs b/src/Juvix/Compiler/Core/Language/Info/TypeInfo.hs
similarity index 51%
rename from src/Juvix/Core/Language/Info/TypeInfo.hs
rename to src/Juvix/Compiler/Core/Language/Info/TypeInfo.hs
index 3006c4ffb5..4d4b54683f 100644
--- a/src/Juvix/Core/Language/Info/TypeInfo.hs
+++ b/src/Juvix/Compiler/Core/Language/Info/TypeInfo.hs
@@ -1,7 +1,7 @@
-module Juvix.Core.Language.Info.TypeInfo where
+module Juvix.Compiler.Core.Language.Info.TypeInfo where
 
-import Juvix.Core.Language.Base
-import Juvix.Core.Language.Type
+import Juvix.Compiler.Core.Language.Base
+import Juvix.Compiler.Core.Language.Type
 
 newtype TypeInfo = TypeInfo {_infoType :: Type}
 
diff --git a/src/Juvix/Core/Language/Type.hs b/src/Juvix/Compiler/Core/Language/Type.hs
similarity index 61%
rename from src/Juvix/Core/Language/Type.hs
rename to src/Juvix/Compiler/Core/Language/Type.hs
index 8fbea3c0dd..0ad4289b06 100644
--- a/src/Juvix/Core/Language/Type.hs
+++ b/src/Juvix/Compiler/Core/Language/Type.hs
@@ -1,6 +1,6 @@
-module Juvix.Core.Language.Type where
+module Juvix.Compiler.Core.Language.Type where
 
-import Juvix.Core.Language.Base
+import Juvix.Compiler.Core.Language.Base
 
 data Type = Atomic Atom | Fun Type Type | Universe
 

From f3e7345235a3f11ac657e1ef088cb6aaa27cd093 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Mon, 8 Aug 2022 09:30:54 +0200
Subject: [PATCH 35/85] remove builtin boolean operations (can be implemeted
 with 'if')

---
 src/Juvix/Compiler/Core/Evaluator.hs         | 7 -------
 src/Juvix/Compiler/Core/Language/Builtins.hs | 4 ----
 2 files changed, 11 deletions(-)

diff --git a/src/Juvix/Compiler/Core/Evaluator.hs b/src/Juvix/Compiler/Core/Evaluator.hs
index a185ef4d69..a1d7ba7b41 100644
--- a/src/Juvix/Compiler/Core/Evaluator.hs
+++ b/src/Juvix/Compiler/Core/Evaluator.hs
@@ -82,8 +82,6 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
     applyBuiltin env OpIntEq [l, r] = nodeFromBool (integerFromNode (eval' env l) == integerFromNode (eval' env r))
     applyBuiltin env OpIntLt [l, r] = nodeFromBool (integerFromNode (eval' env l) < integerFromNode (eval' env r))
     applyBuiltin env OpIntLe [l, r] = nodeFromBool (integerFromNode (eval' env l) <= integerFromNode (eval' env r))
-    applyBuiltin env OpBoolAnd [l, r] = nodeFromBool (boolFromNode (eval' env l) && boolFromNode (eval' env r))
-    applyBuiltin env OpBoolOr [l, r] = nodeFromBool (boolFromNode (eval' env l) || boolFromNode (eval' env r))
     applyBuiltin _ _ _ = evalError "invalid builtin application"
 
     nodeFromInteger :: Integer -> Node
@@ -96,8 +94,3 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
     integerFromNode = \case
       Constant _ (ConstInteger int) -> int
       _ -> evalError "not an integer"
-
-    boolFromNode :: Node -> Bool
-    boolFromNode = \case
-      Constant _ (ConstBool b) -> b
-      _ -> evalError "not a boolean"
diff --git a/src/Juvix/Compiler/Core/Language/Builtins.hs b/src/Juvix/Compiler/Core/Language/Builtins.hs
index 2900c16ddb..97d2a99f42 100644
--- a/src/Juvix/Compiler/Core/Language/Builtins.hs
+++ b/src/Juvix/Compiler/Core/Language/Builtins.hs
@@ -12,8 +12,6 @@ data BuiltinOp
   | OpIntEq
   | OpIntLt
   | OpIntLe
-  | OpBoolAnd
-  | OpBoolOr
   deriving stock (Eq)
 
 -- Builtin data tags
@@ -37,8 +35,6 @@ builtinOpArgsNum = \case
   OpIntEq -> 2
   OpIntLt -> 2
   OpIntLe -> 2
-  OpBoolAnd -> 2
-  OpBoolOr -> 2
 
 builtinConstrArgsNum :: BuiltinDataTag -> Int
 builtinConstrArgsNum = \case

From 89d71cfae913a323faeab89ec0b8405315f1ccfc Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Mon, 8 Aug 2022 17:38:14 +0200
Subject: [PATCH 36/85] pretty printing

---
 src/Juvix/Compiler/Core/Language.hs           |  20 ++
 src/Juvix/Compiler/Core/Language/Base.hs      |   2 +-
 .../Compiler/Core/Language/Info/BranchInfo.hs |  24 ++
 src/Juvix/Compiler/Core/Pretty.hs             |  32 ++
 src/Juvix/Compiler/Core/Pretty/Ann.hs         |  12 +
 src/Juvix/Compiler/Core/Pretty/Ansi.hs        |  12 +
 src/Juvix/Compiler/Core/Pretty/Base.hs        | 302 ++++++++++++++++++
 src/Juvix/Compiler/Core/Pretty/Options.hs     |  17 +
 src/Juvix/Extra/Strings.hs                    |  66 ++++
 9 files changed, 486 insertions(+), 1 deletion(-)
 create mode 100644 src/Juvix/Compiler/Core/Language/Info/BranchInfo.hs
 create mode 100644 src/Juvix/Compiler/Core/Pretty.hs
 create mode 100644 src/Juvix/Compiler/Core/Pretty/Ann.hs
 create mode 100644 src/Juvix/Compiler/Core/Pretty/Ansi.hs
 create mode 100644 src/Juvix/Compiler/Core/Pretty/Base.hs
 create mode 100644 src/Juvix/Compiler/Core/Pretty/Options.hs

diff --git a/src/Juvix/Compiler/Core/Language.hs b/src/Juvix/Compiler/Core/Language.hs
index 4529fba720..cee957e1aa 100644
--- a/src/Juvix/Compiler/Core/Language.hs
+++ b/src/Juvix/Compiler/Core/Language.hs
@@ -117,3 +117,23 @@ data CaseBranch = CaseBranch {caseTag :: !Tag, caseBindersNum :: !Int, caseBranc
 
 -- All nodes in an environment must be values.
 type Env = [Node]
+
+instance HasAtomicity Node where
+  atomicity = \case
+    Var {} -> Atom
+    Ident {} -> Atom
+    Constant {} -> Atom
+    Axiom {} -> Atom
+    App {} -> Aggregate appFixity
+    BuiltinApp {..} | null builtinArgs -> Atom
+    BuiltinApp {} -> Aggregate appFixity
+    ConstrApp {..} | null constrArgs -> Atom
+    ConstrApp {} -> Aggregate appFixity
+    -- TODO: the fixities need to be fixed
+    Lambda {} -> Aggregate appFixity
+    Let {} -> Aggregate appFixity
+    Case {} -> Aggregate appFixity
+    If {} -> Aggregate appFixity
+    Data {} -> Aggregate appFixity
+    Closure {} -> Aggregate appFixity
+    Suspended {} -> Aggregate appFixity
diff --git a/src/Juvix/Compiler/Core/Language/Base.hs b/src/Juvix/Compiler/Core/Language/Base.hs
index 91befc6461..9b6da073db 100644
--- a/src/Juvix/Compiler/Core/Language/Base.hs
+++ b/src/Juvix/Compiler/Core/Language/Base.hs
@@ -7,7 +7,7 @@ module Juvix.Compiler.Core.Language.Base
     module Juvix.Compiler.Abstract.Data.Name,
     Location,
     Symbol,
-    Tag,
+    Tag (..),
     Index,
   )
 where
diff --git a/src/Juvix/Compiler/Core/Language/Info/BranchInfo.hs b/src/Juvix/Compiler/Core/Language/Info/BranchInfo.hs
new file mode 100644
index 0000000000..6acad0dd5b
--- /dev/null
+++ b/src/Juvix/Compiler/Core/Language/Info/BranchInfo.hs
@@ -0,0 +1,24 @@
+module Juvix.Compiler.Core.Language.Info.BranchInfo where
+
+import Juvix.Compiler.Core.Language.Base
+
+newtype BranchInfo = BranchInfo
+  { _infoName :: Name
+  }
+
+instance IsInfo BranchInfo
+
+kBranchInfo :: Key BranchInfo
+kBranchInfo = Proxy
+
+newtype CaseBranchInfo = CaseBranchInfo
+  { _infoBranches :: [BranchInfo]
+  }
+
+instance IsInfo CaseBranchInfo
+
+kCaseBranchInfo :: Key CaseBranchInfo
+kCaseBranchInfo = Proxy
+
+makeLenses ''BranchInfo
+makeLenses ''CaseBranchInfo
diff --git a/src/Juvix/Compiler/Core/Pretty.hs b/src/Juvix/Compiler/Core/Pretty.hs
new file mode 100644
index 0000000000..104413b857
--- /dev/null
+++ b/src/Juvix/Compiler/Core/Pretty.hs
@@ -0,0 +1,32 @@
+module Juvix.Compiler.Core.Pretty
+  ( module Juvix.Compiler.Core.Pretty,
+    module Juvix.Compiler.Core.Pretty.Options,
+  )
+where
+
+import Juvix.Compiler.Core.Pretty.Ann
+import Juvix.Compiler.Core.Pretty.Ansi qualified as Ansi
+import Juvix.Compiler.Core.Pretty.Base
+import Juvix.Compiler.Core.Pretty.Options
+import Juvix.Prelude
+import Juvix.Prelude.Pretty
+import Prettyprinter.Render.Terminal qualified as Ansi
+
+newtype PPOutput = PPOutput (Doc Ann)
+
+ppOutDefault :: PrettyCode c => c -> AnsiText
+ppOutDefault = AnsiText . PPOutput . doc defaultOptions
+
+ppOut :: PrettyCode c => Options -> c -> AnsiText
+ppOut o = AnsiText . PPOutput . doc o
+
+ppTrace :: PrettyCode c => c -> Text
+ppTrace = Ansi.renderStrict . reAnnotateS Ansi.stylize . layoutPretty defaultLayoutOptions . doc defaultOptions
+
+instance HasAnsiBackend PPOutput where
+  toAnsiStream (PPOutput o) = reAnnotateS Ansi.stylize (layoutPretty defaultLayoutOptions o)
+  toAnsiDoc (PPOutput o) = reAnnotate Ansi.stylize o
+
+instance HasTextBackend PPOutput where
+  toTextDoc (PPOutput o) = unAnnotate o
+  toTextStream (PPOutput o) = unAnnotateS (layoutPretty defaultLayoutOptions o)
diff --git a/src/Juvix/Compiler/Core/Pretty/Ann.hs b/src/Juvix/Compiler/Core/Pretty/Ann.hs
new file mode 100644
index 0000000000..e520050145
--- /dev/null
+++ b/src/Juvix/Compiler/Core/Pretty/Ann.hs
@@ -0,0 +1,12 @@
+module Juvix.Compiler.Core.Pretty.Ann where
+
+import Juvix.Compiler.Concrete.Data.NameKind
+
+data Ann
+  = AnnKind NameKind
+  | AnnKeyword
+  | AnnLiteralString
+  | AnnLiteralInteger
+
+instance HasNameKindAnn Ann where
+  annNameKind = AnnKind
diff --git a/src/Juvix/Compiler/Core/Pretty/Ansi.hs b/src/Juvix/Compiler/Core/Pretty/Ansi.hs
new file mode 100644
index 0000000000..739dc15cd8
--- /dev/null
+++ b/src/Juvix/Compiler/Core/Pretty/Ansi.hs
@@ -0,0 +1,12 @@
+module Juvix.Compiler.Core.Pretty.Ansi where
+
+import Juvix.Compiler.Core.Language
+import Juvix.Compiler.Core.Pretty.Base
+import Prettyprinter.Render.Terminal
+
+stylize :: Ann -> AnsiStyle
+stylize a = case a of
+  AnnKind k -> nameKindAnsi k
+  AnnKeyword -> colorDull Blue
+  AnnLiteralString -> colorDull Red
+  AnnLiteralInteger -> colorDull Cyan
diff --git a/src/Juvix/Compiler/Core/Pretty/Base.hs b/src/Juvix/Compiler/Core/Pretty/Base.hs
new file mode 100644
index 0000000000..fb5c200438
--- /dev/null
+++ b/src/Juvix/Compiler/Core/Pretty/Base.hs
@@ -0,0 +1,302 @@
+module Juvix.Compiler.Core.Pretty.Base
+  ( module Juvix.Compiler.Core.Pretty.Base,
+    module Juvix.Compiler.Core.Pretty.Ann,
+    module Juvix.Compiler.Core.Pretty.Options,
+  )
+where
+
+import Juvix.Compiler.Core.Extra
+import Juvix.Compiler.Core.Language
+import Juvix.Compiler.Core.Language.Info qualified as Info
+import Juvix.Compiler.Core.Language.Info.BinderInfo as BinderInfo
+import Juvix.Compiler.Core.Language.Info.BranchInfo as BranchInfo
+import Juvix.Compiler.Core.Language.Info.NameInfo as NameInfo
+import Juvix.Compiler.Core.Pretty.Ann
+import Juvix.Compiler.Core.Pretty.Options
+import Juvix.Extra.Strings qualified as Str
+import Juvix.Prelude.Pretty
+
+doc :: PrettyCode c => Options -> c -> Doc Ann
+doc opts =
+  run
+    . runReader opts
+    . ppCode
+
+class PrettyCode c where
+  ppCode :: Member (Reader Options) r => c -> Sem r (Doc Ann)
+
+runPrettyCode :: PrettyCode c => Options -> c -> Doc Ann
+runPrettyCode opts = run . runReader opts . ppCode
+
+instance PrettyCode NameId where
+  ppCode (NameId k) = return (pretty k)
+
+instance PrettyCode Name where
+  ppCode n = do
+    showNameId <- asks (^. optShowNameIds)
+    return (prettyName showNameId n)
+
+instance PrettyCode BuiltinOp where
+  ppCode = \case
+    OpIntAdd -> return kwPlus
+    OpIntSub -> return kwMinus
+    OpIntMul -> return kwMul
+    OpIntDiv -> return kwDiv
+    OpIntEq -> return kwEquals
+    OpIntLt -> return kwLess
+    OpIntLe -> return kwLessEquals
+
+instance PrettyCode BuiltinDataTag where
+  ppCode = \case
+    TagZero -> return kwZero
+    TagSucc -> return kwSucc
+    TagUnit -> return kwUnit
+    TagNil -> return kwNil
+    TagCons -> return kwCons
+    TagPair -> return kwPair
+
+instance PrettyCode Tag where
+  ppCode = \case
+    BuiltinTag tag -> ppCode tag
+    UserTag tag -> return $ kwUnnamedConstr <+> pretty tag
+
+instance PrettyCode Node where
+  ppCode node = case node of
+    Var {..} ->
+      case Info.lookup kNameInfo varInfo of
+        Just ni -> ppCode (ni ^. NameInfo.infoName)
+        Nothing -> return $ kwDeBruijnVar <+> pretty varIndex
+    Ident {..} ->
+      case Info.lookup kNameInfo identInfo of
+        Just ni -> ppCode (ni ^. NameInfo.infoName)
+        Nothing -> return $ kwUnnamedIdent <+> pretty identSymbol
+    Constant _ (ConstInteger int) -> return $ pretty int
+    Constant _ (ConstBool b) -> return $ pretty b
+    Axiom {..} ->
+      case Info.lookup kNameInfo axiomInfo of
+        Just ni -> ppCode (ni ^. NameInfo.infoName)
+        Nothing -> return kwQuestion
+    App {..} -> do
+      l' <- ppLeftExpression appFixity appLeft
+      r' <- ppRightExpression appFixity appRight
+      return $ l' <+> r'
+    BuiltinApp {..} -> do
+      args' <- mapM (ppRightExpression appFixity) builtinArgs
+      op' <- ppCode builtinOp
+      return $ foldl (<+>) op' args'
+    ConstrApp {..} -> do
+      args' <- mapM (ppRightExpression appFixity) constrArgs
+      n' <-
+        case Info.lookup kNameInfo constrInfo of
+          Just ni -> ppCode (ni ^. NameInfo.infoName)
+          Nothing -> ppCode constrTag
+      return $ foldl (<+>) n' args'
+    Lambda {} -> do
+      let (infos, body) = unfoldLambdas' node
+      pplams <- mapM ppLam infos
+      b <- ppCode body
+      return $ foldr (<+>) (braces b) pplams
+      where
+        ppLam :: Member (Reader Options) r => Info -> Sem r (Doc Ann)
+        ppLam i =
+          case Info.lookup kBinderInfo i of
+            Just bi -> do
+              n <- ppCode (bi ^. BinderInfo.infoName)
+              return $ kwLambda <+> n
+            Nothing -> return $ kwLambda <+> kwQuestion
+    Let {..} -> do
+      n' <-
+        case Info.lookup kBinderInfo letInfo of
+          Just bi -> ppCode (bi ^. BinderInfo.infoName)
+          Nothing -> return kwQuestion
+      v' <- ppCode letValue
+      b' <- ppCode letBody
+      return $ kwLet <+> n' <+> kwAssign <+> v' <+> kwIn <+> b'
+    Case {..} -> do
+      bns <-
+        case Info.lookup kCaseBinderInfo caseInfo of
+          Just ci -> mapM (mapM (ppCode . (^. BinderInfo.infoName))) (ci ^. infoBranchBinders)
+          Nothing -> mapM (\(CaseBranch _ n _) -> replicateM n (return kwQuestion)) caseBranches
+      cns <-
+        case Info.lookup kCaseBranchInfo caseInfo of
+          Just ci -> mapM (ppCode . (^. BranchInfo.infoName)) (ci ^. infoBranches)
+          Nothing -> mapM (\(CaseBranch tag _ _) -> ppCode tag) caseBranches
+      let bs = map (\(CaseBranch _ _ br) -> br) caseBranches
+      v <- ppCode caseValue
+      bs' <- sequence $ zipWith3Exact (\cn bn br -> ppCode br >>= \br' -> return $ foldl (<+>) cn bn <+> kwArrow <+> br') cns bns bs
+      bs'' <-
+        case caseDefault of
+          Just def -> do
+            d' <- ppCode def
+            return $ bs' ++ [kwDefault <+> kwArrow <+> d']
+          Nothing -> return bs'
+      bss <- bracesIndent $ align $ concatWith (\a b -> a <> line <> b <> kwSemicolon) bs''
+      return $ kwCase <+> v <+> kwOf <> bss
+    If {..} -> do
+      v <- ppCode ifValue
+      b1 <- ppCode ifTrueBranch
+      b2 <- ppCode ifFalseBranch
+      return $ kwIf <+> v <+> kwThen <+> b1 <+> kwElse <+> b2
+    Data {..} -> do
+      args' <- mapM (ppRightExpression appFixity) dataArgs
+      n' <-
+        case Info.lookup kNameInfo dataInfo of
+          Just ni -> ppCode (ni ^. NameInfo.infoName)
+          Nothing -> ppCode dataTag
+      return $ kwData <+> foldl (<+>) n' args'
+    Closure {} -> return kwClosure
+    Suspended {..} -> (<+>) kwSuspended <$> ppCode suspendedNode
+
+instance PrettyCode a => PrettyCode (NonEmpty a) where
+  ppCode x = do
+    cs <- mapM ppCode (toList x)
+    return $ encloseSep "(" ")" ", " cs
+
+{--------------------------------------------------------------------------------}
+{- helper functions -}
+
+indent' :: Member (Reader Options) r => Doc a -> Sem r (Doc a)
+indent' d = do
+  i <- asks (^. optIndent)
+  return $ indent i d
+
+bracesIndent :: Members '[Reader Options] r => Doc Ann -> Sem r (Doc Ann)
+bracesIndent d = do
+  d' <- indent' d
+  return $ braces (line <> d' <> line)
+
+parensIf :: Bool -> Doc Ann -> Doc Ann
+parensIf t = if t then parens else id
+
+ppPostExpression ::
+  (PrettyCode a, HasAtomicity a, Member (Reader Options) r) =>
+  Fixity ->
+  a ->
+  Sem r (Doc Ann)
+ppPostExpression = ppLRExpression isPostfixAssoc
+
+ppRightExpression ::
+  (PrettyCode a, HasAtomicity a, Member (Reader Options) r) =>
+  Fixity ->
+  a ->
+  Sem r (Doc Ann)
+ppRightExpression = ppLRExpression isRightAssoc
+
+ppLeftExpression ::
+  (PrettyCode a, HasAtomicity a, Member (Reader Options) r) =>
+  Fixity ->
+  a ->
+  Sem r (Doc Ann)
+ppLeftExpression = ppLRExpression isLeftAssoc
+
+ppLRExpression ::
+  (HasAtomicity a, PrettyCode a, Member (Reader Options) r) =>
+  (Fixity -> Bool) ->
+  Fixity ->
+  a ->
+  Sem r (Doc Ann)
+ppLRExpression associates fixlr e =
+  parensIf (atomParens associates (atomicity e) fixlr)
+    <$> ppCode e
+
+{--------------------------------------------------------------------------------}
+{- keywords -}
+
+keyword :: Text -> Doc Ann
+keyword = annotate AnnKeyword . pretty
+
+kwDeBruijnVar :: Doc Ann
+kwDeBruijnVar = keyword Str.deBruijnVar
+
+kwUnnamedIdent :: Doc Ann
+kwUnnamedIdent = keyword Str.exclamation
+
+kwUnnamedConstr :: Doc Ann
+kwUnnamedConstr = keyword Str.exclamation
+
+kwQuestion :: Doc Ann
+kwQuestion = keyword Str.questionMark
+
+kwLambda :: Doc Ann
+kwLambda = keyword Str.lambdaUnicode
+
+kwArrow :: Doc Ann
+kwArrow = keyword Str.toUnicode
+
+kwAssign :: Doc Ann
+kwAssign = keyword Str.assignUnicode
+
+kwEquals :: Doc Ann
+kwEquals = keyword Str.equal
+
+kwLess :: Doc Ann
+kwLess = keyword Str.less
+
+kwLessEquals :: Doc Ann
+kwLessEquals = keyword Str.lessEqual
+
+kwLet :: Doc Ann
+kwLet = keyword Str.let_
+
+kwIn :: Doc Ann
+kwIn = keyword Str.in_
+
+kwPlus :: Doc Ann
+kwPlus = keyword Str.plus
+
+kwMinus :: Doc Ann
+kwMinus = keyword Str.minus
+
+kwMul :: Doc Ann
+kwMul = keyword Str.mul
+
+kwDiv :: Doc Ann
+kwDiv = keyword Str.div
+
+kwZero :: Doc Ann
+kwZero = keyword Str.zero
+
+kwSucc :: Doc Ann
+kwSucc = keyword Str.succ
+
+kwUnit :: Doc Ann
+kwUnit = keyword Str.unit
+
+kwNil :: Doc Ann
+kwNil = keyword Str.nil
+
+kwCons :: Doc Ann
+kwCons = keyword Str.cons
+
+kwPair :: Doc Ann
+kwPair = keyword Str.pair
+
+kwCase :: Doc Ann
+kwCase = keyword Str.case_
+
+kwOf :: Doc Ann
+kwOf = keyword Str.of_
+
+kwDefault :: Doc Ann
+kwDefault = keyword Str.underscore
+
+kwSemicolon :: Doc Ann
+kwSemicolon = keyword Str.semicolon
+
+kwIf :: Doc Ann
+kwIf = keyword Str.if_
+
+kwThen :: Doc Ann
+kwThen = keyword Str.then_
+
+kwElse :: Doc Ann
+kwElse = keyword Str.else_
+
+kwData :: Doc Ann
+kwData = keyword Str.constrData
+
+kwClosure :: Doc Ann
+kwClosure = keyword Str.closure
+
+kwSuspended :: Doc Ann
+kwSuspended = keyword Str.suspended
diff --git a/src/Juvix/Compiler/Core/Pretty/Options.hs b/src/Juvix/Compiler/Core/Pretty/Options.hs
new file mode 100644
index 0000000000..fabfe89991
--- /dev/null
+++ b/src/Juvix/Compiler/Core/Pretty/Options.hs
@@ -0,0 +1,17 @@
+module Juvix.Compiler.Core.Pretty.Options where
+
+import Juvix.Prelude
+
+data Options = Options
+  { _optIndent :: Int,
+    _optShowNameIds :: Bool
+  }
+
+defaultOptions :: Options
+defaultOptions =
+  Options
+    { _optIndent = 2,
+      _optShowNameIds = False
+    }
+
+makeLenses ''Options
diff --git a/src/Juvix/Extra/Strings.hs b/src/Juvix/Extra/Strings.hs
index 198bb8b3d5..713ba00b0f 100644
--- a/src/Juvix/Extra/Strings.hs
+++ b/src/Juvix/Extra/Strings.hs
@@ -128,9 +128,21 @@ pipe = "|"
 equal :: IsString s => s
 equal = "="
 
+less :: IsString s => s
+less = "<"
+
+lessEqual :: IsString s => s
+lessEqual = "<="
+
 data_ :: IsString s => s
 data_ = "data"
 
+deBruijnVar :: IsString s => s
+deBruijnVar = "$"
+
+exclamation :: IsString s => s
+exclamation = "!"
+
 lambdaUnicode :: IsString s => s
 lambdaUnicode = "λ"
 
@@ -242,6 +254,60 @@ putStrLn_ = "putStrLn"
 debug_ :: IsString s => s
 debug_ = "debug"
 
+plus :: IsString s => s
+plus = "+"
+
+minus :: IsString s => s
+minus = "-"
+
+mul :: IsString s => s
+mul = "*"
+
+div :: IsString s => s
+div = "/"
+
+if_ :: IsString s => s
+if_ = "if"
+
+then_ :: IsString s => s
+then_ = "then"
+
+else_ :: IsString s => s
+else_ = "else"
+
+zero :: IsString s => s
+zero = "0"
+
+succ :: IsString s => s
+succ = "S"
+
+unit :: IsString s => s
+unit = "unit"
+
+nil :: IsString s => s
+nil = "nil"
+
+cons :: IsString s => s
+cons = "cons"
+
+pair :: IsString s => s
+pair = "pair"
+
+case_ :: IsString s => s
+case_ = "case"
+
+of_ :: IsString s => s
+of_ = "of"
+
+closure :: IsString s => s
+closure = "<closure>"
+
+suspended :: IsString s => s
+suspended = "<suspended>"
+
+constrData :: IsString s => s
+constrData = "<data>"
+
 juvixFunctionT :: IsString s => s
 juvixFunctionT = "juvix_function_t"
 

From f4354ca9548230b9f14fd2a002c0910bfbbb3242 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Wed, 10 Aug 2022 15:50:13 +0200
Subject: [PATCH 37/85] parser for Node

---
 .../Analysis/Scoping/Error/Types.hs           |   1 -
 .../Concrete/Translation/FromSource.hs        |   4 +-
 .../Concrete/Translation/FromSource/Lexer.hs  |  88 +--
 src/Juvix/Compiler/Core/Data/InfoTable.hs     |  18 +-
 .../Compiler/Core/Data/InfoTableBuilder.hs    |  73 +++
 src/Juvix/Compiler/Core/Language.hs           |   4 +-
 src/Juvix/Compiler/Core/Language/Info.hs      |   3 +
 src/Juvix/Compiler/Core/Language/Type.hs      |   4 +-
 .../Compiler/Core/Translation/FromSource.hs   | 518 ++++++++++++++++++
 .../Core/Translation/FromSource/Lexer.hs      | 184 +++++++
 src/Juvix/Extra/Strings.hs                    |  15 +
 .../FromSource => Parser}/Error.hs            |   4 +-
 src/Juvix/Parser/Lexer.hs                     | 114 ++++
 13 files changed, 946 insertions(+), 84 deletions(-)
 create mode 100644 src/Juvix/Compiler/Core/Data/InfoTableBuilder.hs
 create mode 100644 src/Juvix/Compiler/Core/Translation/FromSource.hs
 create mode 100644 src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs
 rename src/Juvix/{Compiler/Concrete/Translation/FromSource => Parser}/Error.hs (88%)
 create mode 100644 src/Juvix/Parser/Lexer.hs

diff --git a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Types.hs b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Types.hs
index 4a27c3b8f8..8560c79559 100644
--- a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Types.hs
+++ b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Types.hs
@@ -13,7 +13,6 @@ import Juvix.Compiler.Concrete.Data.ScopedName qualified as S
 import Juvix.Compiler.Concrete.Language
 import Juvix.Compiler.Concrete.Language qualified as L
 import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping.Error.Pretty
-import Juvix.Compiler.Concrete.Translation.FromSource.Error qualified as Parser
 import Juvix.Data.CodeAnn
 import Juvix.Prelude
 
diff --git a/src/Juvix/Compiler/Concrete/Translation/FromSource.hs b/src/Juvix/Compiler/Concrete/Translation/FromSource.hs
index 1488c778fa..56d56353a0 100644
--- a/src/Juvix/Compiler/Concrete/Translation/FromSource.hs
+++ b/src/Juvix/Compiler/Concrete/Translation/FromSource.hs
@@ -2,7 +2,7 @@ module Juvix.Compiler.Concrete.Translation.FromSource
   ( module Juvix.Compiler.Concrete.Translation.FromSource,
     module Juvix.Compiler.Concrete.Translation.FromSource.Data.Context,
     module Juvix.Compiler.Concrete.Data.ParsedInfoTable,
-    module Juvix.Compiler.Concrete.Translation.FromSource.Error,
+    module Juvix.Parser.Error,
   )
 where
 
@@ -14,9 +14,9 @@ import Juvix.Compiler.Concrete.Extra (MonadParsec (takeWhile1P))
 import Juvix.Compiler.Concrete.Extra qualified as P
 import Juvix.Compiler.Concrete.Language
 import Juvix.Compiler.Concrete.Translation.FromSource.Data.Context
-import Juvix.Compiler.Concrete.Translation.FromSource.Error
 import Juvix.Compiler.Concrete.Translation.FromSource.Lexer hiding (symbol)
 import Juvix.Compiler.Pipeline.EntryPoint
+import Juvix.Parser.Error
 import Juvix.Prelude
 import Juvix.Prelude.Pretty (Pretty, prettyText)
 
diff --git a/src/Juvix/Compiler/Concrete/Translation/FromSource/Lexer.hs b/src/Juvix/Compiler/Concrete/Translation/FromSource/Lexer.hs
index d7c047b85d..8ed631411e 100644
--- a/src/Juvix/Compiler/Concrete/Translation/FromSource/Lexer.hs
+++ b/src/Juvix/Compiler/Concrete/Translation/FromSource/Lexer.hs
@@ -1,39 +1,21 @@
-module Juvix.Compiler.Concrete.Translation.FromSource.Lexer where
+module Juvix.Compiler.Concrete.Translation.FromSource.Lexer
+  ( module Juvix.Compiler.Concrete.Translation.FromSource.Lexer,
+    module Juvix.Parser.Lexer,
+  )
+where
 
 import Data.Text qualified as Text
 import GHC.Unicode
 import Juvix.Compiler.Concrete.Data.ParsedInfoTableBuilder
-import Juvix.Compiler.Concrete.Extra hiding (Pos, space)
+import Juvix.Compiler.Concrete.Extra hiding (Pos, space, string')
 import Juvix.Compiler.Concrete.Extra qualified as P
 import Juvix.Extra.Strings qualified as Str
+import Juvix.Parser.Lexer
 import Juvix.Prelude
 import Text.Megaparsec.Char.Lexer qualified as L
 
 type OperatorSym = Text
 
-type ParsecS r = ParsecT Void Text (Sem r)
-
-newtype ParserParams = ParserParams
-  { _parserParamsRoot :: FilePath
-  }
-
-makeLenses ''ParserParams
-
-space :: forall r. Members '[Reader ParserParams, InfoTableBuilder] r => ParsecS r ()
-space = L.space space1 lineComment block
-  where
-    skipLineComment :: ParsecS r ()
-    skipLineComment = do
-      notFollowedBy (P.chunk Str.judocStart)
-      void (P.chunk "--")
-      void (P.takeWhileP Nothing (/= '\n'))
-
-    lineComment :: ParsecS r ()
-    lineComment = comment_ skipLineComment
-
-    block :: ParsecS r ()
-    block = comment_ (L.skipBlockComment "{-" "-}")
-
 comment :: Members '[Reader ParserParams, InfoTableBuilder] r => ParsecS r a -> ParsecS r a
 comment c = do
   (a, i) <- interval c
@@ -43,6 +25,9 @@ comment c = do
 comment_ :: Members '[Reader ParserParams, InfoTableBuilder] r => ParsecS r a -> ParsecS r ()
 comment_ = void . comment
 
+space :: forall r. Members '[Reader ParserParams, InfoTableBuilder] r => ParsecS r ()
+space = space' True comment_
+
 lexeme :: Members '[Reader ParserParams, InfoTableBuilder] r => ParsecS r a -> ParsecS r a
 lexeme = L.lexeme space
 
@@ -62,13 +47,7 @@ identifierL :: Members '[Reader ParserParams, InfoTableBuilder] r => ParsecS r (
 identifierL = lexeme bareIdentifier
 
 integer :: Members '[Reader ParserParams, InfoTableBuilder] r => ParsecS r (Integer, Interval)
-integer = do
-  minus <- optional (char '-')
-  (nat, i) <- decimal
-  let nat' = case minus of
-        Nothing -> nat
-        _ -> (-nat)
-  return (nat', i)
+integer = integer' decimal
 
 bracedString :: forall e m. MonadParsec e Text m => m Text
 bracedString =
@@ -86,9 +65,7 @@ bracedString =
       char '}'
 
 string :: Members '[Reader ParserParams, InfoTableBuilder] r => ParsecS r (Text, Interval)
-string =
-  lexemeInterval $
-    pack <$> (char '"' >> manyTill L.charLiteral (char '"'))
+string = lexemeInterval string'
 
 judocExampleStart :: ParsecS r ()
 judocExampleStart = P.chunk Str.judocExample >> hspace
@@ -99,51 +76,14 @@ judocStart = P.chunk Str.judocStart >> hspace
 judocEmptyLine :: Members '[Reader ParserParams, InfoTableBuilder] r => ParsecS r ()
 judocEmptyLine = lexeme (void (P.try (judocStart >> P.newline)))
 
-curLoc :: Member (Reader ParserParams) r => ParsecS r Loc
-curLoc = do
-  sp <- getSourcePos
-  offset <- getOffset
-  root <- lift (asks (^. parserParamsRoot))
-  return (mkLoc root offset sp)
-
-interval :: Member (Reader ParserParams) r => ParsecS r a -> ParsecS r (a, Interval)
-interval ma = do
-  start <- curLoc
-  res <- ma
-  end <- curLoc
-  return (res, mkInterval start end)
-
-withLoc :: Member (Reader ParserParams) r => ParsecS r a -> ParsecS r (WithLoc a)
-withLoc ma = do
-  (a, i) <- interval ma
-  return (WithLoc i a)
-
 keyword :: Members '[Reader ParserParams, InfoTableBuilder] r => Text -> ParsecS r ()
 keyword kw = do
-  l <- P.try $ do
-    i <- snd <$> interval (P.chunk kw)
-    notFollowedBy (satisfy validTailChar)
-    space
-    return i
+  l <- keywordL' space kw
   lift (registerKeyword l)
 
 -- | Same as @identifier@ but does not consume space after it.
 bareIdentifier :: Members '[Reader ParserParams, InfoTableBuilder] r => ParsecS r (Text, Interval)
-bareIdentifier = interval $ do
-  notFollowedBy (choice allKeywords)
-  h <- P.satisfy validFirstChar
-  t <- P.takeWhileP Nothing validTailChar
-  return (Text.cons h t)
-
-validTailChar :: Char -> Bool
-validTailChar c =
-  isAlphaNum c || validFirstChar c
-
-reservedSymbols :: [Char]
-reservedSymbols = "\";(){}[].≔λ\\"
-
-validFirstChar :: Char -> Bool
-validFirstChar c = not $ isNumber c || isSpace c || (c `elem` reservedSymbols)
+bareIdentifier = interval $ rawIdentifier allKeywords
 
 dot :: forall e m. MonadParsec e Text m => m Char
 dot = P.char '.'
diff --git a/src/Juvix/Compiler/Core/Data/InfoTable.hs b/src/Juvix/Compiler/Core/Data/InfoTable.hs
index 983a061042..ad0ad8efe5 100644
--- a/src/Juvix/Compiler/Core/Data/InfoTable.hs
+++ b/src/Juvix/Compiler/Core/Data/InfoTable.hs
@@ -7,18 +7,31 @@ type IdentContext = HashMap Symbol Node
 
 data InfoTable = InfoTable
   { _identContext :: IdentContext,
+    -- `_identMap` is needed only for REPL
+    _identMap :: HashMap Text (Either Symbol Tag),
     _infoIdents :: HashMap Symbol IdentInfo,
     _infoInductives :: HashMap Name InductiveInfo,
     _infoConstructors :: HashMap Tag ConstructorInfo,
     _infoAxioms :: HashMap Name AxiomInfo
   }
 
+emptyInfoTable :: InfoTable
+emptyInfoTable =
+  InfoTable
+    { _identContext = mempty,
+      _identMap = mempty,
+      _infoIdents = mempty,
+      _infoInductives = mempty,
+      _infoConstructors = mempty,
+      _infoAxioms = mempty
+    }
+
 data IdentInfo = IdentInfo
   { _identName :: Name,
     _identSymbol :: Symbol,
     _identType :: Type,
-    _identArgsNum :: Int,
     -- _identArgsNum will be used often enough to justify avoiding recomputation
+    _identArgsNum :: Int,
     _identArgsInfo :: [ArgumentInfo],
     _identIsExported :: Bool
   }
@@ -40,7 +53,8 @@ data InductiveInfo = InductiveInfo
 data ConstructorInfo = ConstructorInfo
   { _constructorName :: Name,
     _constructorTag :: Tag,
-    _constructorType :: Type
+    _constructorType :: Type,
+    _constructorArgsNum :: Int
   }
 
 data ParameterInfo = ParameterInfo
diff --git a/src/Juvix/Compiler/Core/Data/InfoTableBuilder.hs b/src/Juvix/Compiler/Core/Data/InfoTableBuilder.hs
new file mode 100644
index 0000000000..7e137beb03
--- /dev/null
+++ b/src/Juvix/Compiler/Core/Data/InfoTableBuilder.hs
@@ -0,0 +1,73 @@
+module Juvix.Compiler.Core.Data.InfoTableBuilder where
+
+import Data.HashMap.Strict qualified as HashMap
+import Juvix.Compiler.Core.Data.InfoTable
+import Juvix.Compiler.Core.Language
+
+data InfoTableBuilder m a where
+  FreshSymbol :: InfoTableBuilder m Symbol
+  FreshTag :: InfoTableBuilder m Tag
+  RegisterIdent :: IdentInfo -> InfoTableBuilder m ()
+  RegisterConstructor :: ConstructorInfo -> InfoTableBuilder m ()
+  RegisterIdentNode :: Symbol -> Node -> InfoTableBuilder m ()
+  SetIdentArgsInfo :: Symbol -> [ArgumentInfo] -> InfoTableBuilder m ()
+  GetIdent :: Text -> InfoTableBuilder m (Maybe (Either Symbol Tag))
+  GetInfoTable :: InfoTableBuilder m InfoTable
+
+makeSem ''InfoTableBuilder
+
+hasIdent :: Member InfoTableBuilder r => Text -> Sem r Bool
+hasIdent txt = do
+  i <- getIdent txt
+  case i of
+    Just _ -> return True
+    Nothing -> return False
+
+data BuilderState = BuilderState
+  { _stateNextSymbol :: Word,
+    _stateNextUserTag :: Word,
+    _stateInfoTable :: InfoTable
+  }
+
+makeLenses ''BuilderState
+
+initBuilderState :: InfoTable -> BuilderState
+initBuilderState tab =
+  BuilderState
+    { _stateNextSymbol = fromIntegral $ HashMap.size (tab ^. infoIdents),
+      _stateNextUserTag = fromIntegral $ HashMap.size (tab ^. infoConstructors),
+      _stateInfoTable = tab
+    }
+
+runInfoTableBuilder :: InfoTable -> Sem (InfoTableBuilder ': r) a -> Sem r (InfoTable, a)
+runInfoTableBuilder tab =
+  fmap (first (^. stateInfoTable))
+    . runState (initBuilderState tab)
+    . reinterpret interp
+  where
+    interp :: InfoTableBuilder m a -> Sem (State BuilderState : r) a
+    interp = \case
+      FreshSymbol -> do
+        modify' (over stateNextSymbol (+ 1))
+        s <- get
+        return (s ^. stateNextSymbol - 1)
+      FreshTag -> do
+        modify' (over stateNextUserTag (+ 1))
+        s <- get
+        return (UserTag (s ^. stateNextUserTag - 1))
+      RegisterIdent ii -> do
+        modify' (over stateInfoTable (over infoIdents (HashMap.insert (ii ^. identSymbol) ii)))
+        modify' (over stateInfoTable (over identMap (HashMap.insert (ii ^. (identName . nameText)) (Left (ii ^. identSymbol)))))
+      RegisterConstructor ci -> do
+        modify' (over stateInfoTable (over infoConstructors (HashMap.insert (ci ^. constructorTag) ci)))
+        modify' (over stateInfoTable (over identMap (HashMap.insert (ci ^. (constructorName . nameText)) (Right (ci ^. constructorTag)))))
+      RegisterIdentNode sym node ->
+        modify' (over stateInfoTable (over identContext (HashMap.insert sym node)))
+      SetIdentArgsInfo sym argsInfo -> do
+        modify' (over stateInfoTable (over infoIdents (HashMap.adjust (set identArgsInfo argsInfo) sym)))
+        modify' (over stateInfoTable (over infoIdents (HashMap.adjust (set identArgsNum (length argsInfo)) sym)))
+      GetIdent txt -> do
+        s <- get
+        return $ HashMap.lookup txt (s ^. (stateInfoTable . identMap))
+      GetInfoTable ->
+        get <&> (^. stateInfoTable)
diff --git a/src/Juvix/Compiler/Core/Language.hs b/src/Juvix/Compiler/Core/Language.hs
index cee957e1aa..2bfd71db0c 100644
--- a/src/Juvix/Compiler/Core/Language.hs
+++ b/src/Juvix/Compiler/Core/Language.hs
@@ -77,7 +77,7 @@ data Node
         closureBody :: !Node
       }
   | -- Evaluation only: a suspended term value which cannot be evaluated
-    -- further, e.g., a hole applied to some arguments. The suspended term must
+    -- further, e.g., a hole applied to some arguments. `suspendedNode` must
     -- be closed (but need not be a value -- see below).
     Suspended {suspendedInfo :: !Info, suspendedNode :: !Node}
 
@@ -112,7 +112,7 @@ data CaseBranch = CaseBranch {caseTag :: !Tag, caseBindersNum :: !Int, caseBranc
 -- - Closure
 -- - Suspended
 --
--- Whether something is a value matters only for evaluation semantics. It
+-- Whether something is a value matters only for the evaluation semantics. It
 -- doesn't matter much outside the evaluator.
 
 -- All nodes in an environment must be values.
diff --git a/src/Juvix/Compiler/Core/Language/Info.hs b/src/Juvix/Compiler/Core/Language/Info.hs
index b0cc32d46f..22164f3148 100644
--- a/src/Juvix/Compiler/Core/Language/Info.hs
+++ b/src/Juvix/Compiler/Core/Language/Info.hs
@@ -22,6 +22,9 @@ makeLenses ''Info
 empty :: Info
 empty = Info HashMap.empty
 
+singleton :: forall a. IsInfo a => a -> Info
+singleton a = Juvix.Compiler.Core.Language.Info.insert a Juvix.Compiler.Core.Language.Info.empty
+
 member :: forall a. IsInfo a => Key a -> Info -> Bool
 member k i = HashMap.member (typeRep k) (i ^. infoMap)
 
diff --git a/src/Juvix/Compiler/Core/Language/Type.hs b/src/Juvix/Compiler/Core/Language/Type.hs
index 0ad4289b06..6ebb1993ee 100644
--- a/src/Juvix/Compiler/Core/Language/Type.hs
+++ b/src/Juvix/Compiler/Core/Language/Type.hs
@@ -2,7 +2,9 @@ module Juvix.Compiler.Core.Language.Type where
 
 import Juvix.Compiler.Core.Language.Base
 
-data Type = Atomic Atom | Fun Type Type | Universe
+-- Star (*) allows to specify the type partially, e.g.: * -> * -> *.
+-- Star in the target is assumed to be an atom.
+data Type = Atomic Atom | Fun Type Type | Universe | Star
 
 data Atom = Atom
   { _atomHead :: Name,
diff --git a/src/Juvix/Compiler/Core/Translation/FromSource.hs b/src/Juvix/Compiler/Core/Translation/FromSource.hs
new file mode 100644
index 0000000000..b02a451d05
--- /dev/null
+++ b/src/Juvix/Compiler/Core/Translation/FromSource.hs
@@ -0,0 +1,518 @@
+module Juvix.Compiler.Core.Translation.FromSource where
+
+import Control.Monad.Trans.Class (lift)
+import Data.HashMap.Strict qualified as HashMap
+import Data.List qualified as List
+import Juvix.Compiler.Core.Data.InfoTable
+import Juvix.Compiler.Core.Data.InfoTableBuilder
+import Juvix.Compiler.Core.Extra.Base
+import Juvix.Compiler.Core.Language
+import Juvix.Compiler.Core.Language.Info qualified as Info
+import Juvix.Compiler.Core.Language.Info.BinderInfo as BinderInfo
+import Juvix.Compiler.Core.Language.Info.LocationInfo as LocationInfo
+import Juvix.Compiler.Core.Language.Info.NameInfo as NameInfo
+import Juvix.Compiler.Core.Language.Type
+import Juvix.Compiler.Core.Translation.FromSource.Lexer
+import Juvix.Parser.Error
+import Text.Megaparsec qualified as P
+
+parseText :: InfoTable -> Text -> Either ParserError (InfoTable, Maybe Node)
+parseText = runParser "" ""
+
+runParser :: FilePath -> FilePath -> InfoTable -> Text -> Either ParserError (InfoTable, Maybe Node)
+runParser root fileName tab input =
+  case run $
+    runInfoTableBuilder tab $
+      runReader params $
+        runNameIdGen $
+          P.runParserT parseToplevel fileName input of
+    (_, Left err) -> Left (ParserError err)
+    (tbl, Right r) -> Right (tbl, r)
+  where
+    params =
+      ParserParams
+        { _parserParamsRoot = root
+        }
+
+freshName ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  NameKind ->
+  Text ->
+  Interval ->
+  ParsecS r Name
+freshName kind txt i = do
+  nid <- lift freshNameId
+  return $
+    Name
+      { _nameText = txt,
+        _nameId = nid,
+        _nameKind = kind,
+        _namePretty = txt,
+        _nameLoc = i
+      }
+
+parseToplevel ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  ParsecS r (Maybe Node)
+parseToplevel = do
+  space
+  P.sepEndBy statement kwSemicolon
+  optional expression
+
+statement ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  ParsecS r ()
+statement = statementDef <|> statementConstr
+
+statementDef ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  ParsecS r ()
+statementDef = do
+  kwDef
+  (txt, i) <- identifierL
+  r <- lift (getIdent txt)
+  case r of
+    Just (Left sym) -> do
+      tab <- lift getInfoTable
+      when
+        (HashMap.member sym (tab ^. identContext))
+        (parseFailure ("duplicate definition of: " ++ fromText txt))
+      parseDefinition sym
+    Just (Right {}) ->
+      parseFailure ("duplicate identifier: " ++ fromText txt)
+    Nothing -> do
+      sym <- lift freshSymbol
+      name <- freshName KNameFunction txt i
+      let info =
+            IdentInfo
+              { _identName = name,
+                _identSymbol = sym,
+                _identType = Star,
+                _identArgsNum = 0,
+                _identArgsInfo = [],
+                _identIsExported = False
+              }
+      lift $ registerIdent info
+      void $ optional (parseDefinition sym)
+
+parseDefinition ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Symbol ->
+  ParsecS r ()
+parseDefinition sym = do
+  kwAssignment
+  node <- expression
+  lift $ registerIdentNode sym node
+  let (is, _) = unfoldLambdas' node
+  lift $ setIdentArgsInfo sym (map toArgumentInfo is)
+  where
+    toArgumentInfo :: Info -> ArgumentInfo
+    toArgumentInfo i =
+      case Info.lookup kBinderInfo i of
+        Just bi ->
+          ArgumentInfo
+            { _argumentName = bi ^. BinderInfo.infoName,
+              _argumentType = bi ^. BinderInfo.infoType,
+              _argumentIsImplicit = False
+            }
+        Nothing -> error "missing binder info"
+
+statementConstr ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  ParsecS r ()
+statementConstr = do
+  kwConstr
+  (txt, i) <- identifierL
+  (argsNum, _) <- number 0 128
+  dupl <- lift (hasIdent txt)
+  when
+    dupl
+    (parseFailure ("duplicate identifier: " ++ fromText txt))
+  tag <- lift freshTag
+  name <- freshName KNameConstructor txt i
+  let info =
+        ConstructorInfo
+          { _constructorName = name,
+            _constructorTag = tag,
+            _constructorType = Star,
+            _constructorArgsNum = argsNum
+          }
+  lift $ registerConstructor info
+
+expression ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  ParsecS r Node
+expression = expr 0 mempty
+
+expr ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Index ->
+  HashMap Text Index ->
+  ParsecS r Node
+expr varsNum vars = cmpExpr varsNum vars
+
+cmpExpr ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Index ->
+  HashMap Text Index ->
+  ParsecS r Node
+cmpExpr varsNum vars = arithExpr varsNum vars >>= cmpExpr' varsNum vars
+
+cmpExpr' ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Index ->
+  HashMap Text Index ->
+  Node ->
+  ParsecS r Node
+cmpExpr' varsNum vars node =
+  eqExpr' varsNum vars node <|> ltExpr' varsNum vars node <|> leExpr' varsNum vars node <|> return node
+
+eqExpr' ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Index ->
+  HashMap Text Index ->
+  Node ->
+  ParsecS r Node
+eqExpr' varsNum vars node = do
+  kwEq
+  node' <- arithExpr varsNum vars
+  return $ BuiltinApp Info.empty OpIntEq [node, node']
+
+ltExpr' ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Index ->
+  HashMap Text Index ->
+  Node ->
+  ParsecS r Node
+ltExpr' varsNum vars node = do
+  kwLt
+  node' <- arithExpr varsNum vars
+  return $ BuiltinApp Info.empty OpIntLt [node, node']
+
+leExpr' ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Index ->
+  HashMap Text Index ->
+  Node ->
+  ParsecS r Node
+leExpr' varsNum vars node = do
+  kwLe
+  node' <- arithExpr varsNum vars
+  return $ BuiltinApp Info.empty OpIntLe [node, node']
+
+gtExpr' ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Index ->
+  HashMap Text Index ->
+  Node ->
+  ParsecS r Node
+gtExpr' varsNum vars node = do
+  kwGt
+  node' <- arithExpr varsNum vars
+  return $ BuiltinApp Info.empty OpIntLt [node', node]
+
+geExpr' ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Index ->
+  HashMap Text Index ->
+  Node ->
+  ParsecS r Node
+geExpr' varsNum vars node = do
+  kwGe
+  node' <- arithExpr varsNum vars
+  return $ BuiltinApp Info.empty OpIntLe [node', node]
+
+arithExpr ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Index ->
+  HashMap Text Index ->
+  ParsecS r Node
+arithExpr varsNum vars = multExpr varsNum vars >>= arithExpr' varsNum vars
+
+arithExpr' ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Index ->
+  HashMap Text Index ->
+  Node ->
+  ParsecS r Node
+arithExpr' varsNum vars node =
+  plusExpr' varsNum vars node <|> minusExpr' varsNum vars node <|> return node
+
+plusExpr' ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Index ->
+  HashMap Text Index ->
+  Node ->
+  ParsecS r Node
+plusExpr' varsNum vars node = do
+  kwPlus
+  node' <- multExpr varsNum vars
+  arithExpr' varsNum vars (BuiltinApp Info.empty OpIntAdd [node, node'])
+
+minusExpr' ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Index ->
+  HashMap Text Index ->
+  Node ->
+  ParsecS r Node
+minusExpr' varsNum vars node = do
+  kwMinus
+  node' <- multExpr varsNum vars
+  arithExpr' varsNum vars (BuiltinApp Info.empty OpIntSub [node, node'])
+
+multExpr ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Index ->
+  HashMap Text Index ->
+  ParsecS r Node
+multExpr varsNum vars = appExpr varsNum vars >>= multExpr' varsNum vars
+
+multExpr' ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Index ->
+  HashMap Text Index ->
+  Node ->
+  ParsecS r Node
+multExpr' varsNum vars node =
+  mulExpr' varsNum vars node <|> divExpr' varsNum vars node <|> return node
+
+mulExpr' ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Index ->
+  HashMap Text Index ->
+  Node ->
+  ParsecS r Node
+mulExpr' varsNum vars node = do
+  kwMul
+  node' <- appExpr varsNum vars
+  multExpr' varsNum vars (BuiltinApp Info.empty OpIntMul [node, node'])
+
+divExpr' ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Index ->
+  HashMap Text Index ->
+  Node ->
+  ParsecS r Node
+divExpr' varsNum vars node = do
+  kwDiv
+  node' <- appExpr varsNum vars
+  multExpr' varsNum vars (BuiltinApp Info.empty OpIntDiv [node, node'])
+
+appExpr ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Index ->
+  HashMap Text Index ->
+  ParsecS r Node
+appExpr varsNum vars = builtinAppExpr varsNum vars <|> atoms varsNum vars
+
+builtinAppExpr ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Index ->
+  HashMap Text Index ->
+  ParsecS r Node
+builtinAppExpr varsNum vars = do
+  op <-
+    (kwEq >> return OpIntEq)
+      <|> (kwLt >> return OpIntLt)
+      <|> (kwLe >> return OpIntLe)
+      <|> (kwPlus >> return OpIntAdd)
+      <|> (kwMinus >> return OpIntSub)
+      <|> (kwDiv >> return OpIntDiv)
+      <|> (kwMul >> return OpIntMul)
+  args <- P.some (atom varsNum vars)
+  return $ BuiltinApp Info.empty op args
+
+atoms ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Index ->
+  HashMap Text Index ->
+  ParsecS r Node
+atoms varsNum vars = do
+  es <- P.some (atom varsNum vars)
+  return $ mkApp (List.head es) (List.tail es)
+
+atom ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  -- current de Bruijn index, i.e., the number of binders upwards
+  Index ->
+  -- reverse de Bruijn indices
+  HashMap Text Index ->
+  ParsecS r Node
+atom varsNum vars =
+  exprNamed varsNum vars
+    <|> exprConstInt
+    <|> exprConstBool
+    <|> exprLambda varsNum vars
+    <|> exprLet varsNum vars
+    <|> exprCase varsNum vars
+    <|> exprIf varsNum vars
+    <|> parens (expr varsNum vars)
+    <|> braces (expr varsNum vars)
+
+exprNamed ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Index ->
+  HashMap Text Index ->
+  ParsecS r Node
+exprNamed varsNum vars = do
+  (txt, i) <- identifierL
+  case HashMap.lookup txt vars of
+    Just k -> do
+      name <- freshName KNameLocal txt i
+      return $ Var (Info.singleton (NameInfo name)) (varsNum - k - 1)
+    Nothing -> do
+      r <- lift (getIdent txt)
+      case r of
+        Just (Left sym) -> do
+          name <- freshName KNameFunction txt i
+          return $ Ident (Info.singleton (NameInfo name)) sym
+        Just (Right tag) -> do
+          name <- freshName KNameConstructor txt i
+          return $ ConstrApp (Info.singleton (NameInfo name)) tag []
+        Nothing ->
+          parseFailure ("undeclared identifier: " ++ fromText txt)
+
+exprConstInt ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  ParsecS r Node
+exprConstInt = P.try $ do
+  (n, i) <- integer
+  return $ Constant (Info.singleton (LocationInfo i)) (ConstInteger n)
+
+exprConstBool ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  ParsecS r Node
+exprConstBool = P.try $ do
+  (b, i) <- boolean
+  return $ Constant (Info.singleton (LocationInfo i)) (ConstBool b)
+
+parseLocalName ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  ParsecS r Name
+parseLocalName = do
+  (txt, i) <- identifierL
+  freshName KNameLocal txt i
+
+exprLambda ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Index ->
+  HashMap Text Index ->
+  ParsecS r Node
+exprLambda varsNum vars = do
+  kwLambda
+  name <- parseLocalName
+  optional kwMapsTo
+  let vars' = HashMap.insert (name ^. nameText) varsNum vars
+  body <- expr (varsNum + 1) vars'
+  return $ Lambda (Info.singleton (BinderInfo name Star)) body
+
+exprLet ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Index ->
+  HashMap Text Index ->
+  ParsecS r Node
+exprLet varsNum vars = do
+  kwLet
+  name <- parseLocalName
+  kwAssignment
+  value <- expr varsNum vars
+  kwIn
+  let vars' = HashMap.insert (name ^. nameText) varsNum vars
+  body <- expr (varsNum + 1) vars'
+  return $ Let (Info.singleton (BinderInfo name Star)) value body
+
+exprCase ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Index ->
+  HashMap Text Index ->
+  ParsecS r Node
+exprCase varsNum vars = do
+  kwCase
+  value <- expr varsNum vars
+  kwOf
+  braces (exprCase' value varsNum vars)
+    <|> exprCase' value varsNum vars
+
+exprCase' ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Node ->
+  Index ->
+  HashMap Text Index ->
+  ParsecS r Node
+exprCase' value varsNum vars = do
+  bs <- P.sepEndBy (caseBranch varsNum vars) kwSemicolon
+  rbrace
+  let bs' = map fromLeft' $ filter isLeft bs
+  let def' = map fromRight' $ filter isRight bs
+  case def' of
+    [def] ->
+      return $ Case Info.empty value bs' (Just def)
+    [] ->
+      return $ Case Info.empty value bs' Nothing
+    _ ->
+      parseFailure "multiple default branches"
+
+caseBranch ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Index ->
+  HashMap Text Index ->
+  ParsecS r (Either CaseBranch Node)
+caseBranch varsNum vars =
+  (defaultBranch varsNum vars <&> Right)
+    <|> (matchingBranch varsNum vars <&> Left)
+
+defaultBranch ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Index ->
+  HashMap Text Index ->
+  ParsecS r Node
+defaultBranch varsNum vars = do
+  kwWildcard
+  kwMapsTo
+  expr varsNum vars
+
+matchingBranch ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Index ->
+  HashMap Text Index ->
+  ParsecS r CaseBranch
+matchingBranch varsNum vars = do
+  txt <- identifier
+  r <- lift (getIdent txt)
+  case r of
+    Just (Left {}) ->
+      parseFailure ("not a constructor: " ++ fromText txt)
+    Just (Right tag) -> do
+      ns <- P.many parseLocalName
+      let bindersNum = length ns
+      tab <- lift getInfoTable
+      when
+        (fromJust (HashMap.lookup tag (tab ^. infoConstructors)) ^. constructorArgsNum /= bindersNum)
+        (parseFailure "wrong number of constructor arguments")
+      kwMapsTo
+      let vars' =
+            fst $
+              foldl'
+                ( \(vs, k) name ->
+                    (HashMap.insert (name ^. nameText) k vs, k + 1)
+                )
+                (vars, varsNum)
+                ns
+      br <- expr (varsNum + bindersNum) vars'
+      return $ CaseBranch tag bindersNum br
+    Nothing ->
+      parseFailure ("undeclared identifier: " ++ fromText txt)
+
+exprIf ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Index ->
+  HashMap Text Index ->
+  ParsecS r Node
+exprIf varsNum vars = do
+  kwIf
+  value <- expr varsNum vars
+  kwThen
+  br1 <- expr varsNum vars
+  kwElse
+  br2 <- expr varsNum vars
+  return $ If Info.empty value br1 br2
diff --git a/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs b/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs
new file mode 100644
index 0000000000..49875555da
--- /dev/null
+++ b/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs
@@ -0,0 +1,184 @@
+module Juvix.Compiler.Core.Translation.FromSource.Lexer
+  ( module Juvix.Compiler.Core.Translation.FromSource.Lexer,
+    module Juvix.Parser.Lexer,
+  )
+where
+
+import Juvix.Extra.Strings qualified as Str
+import Juvix.Parser.Lexer
+import Juvix.Prelude
+import Text.Megaparsec as P hiding (sepBy1, sepEndBy1, some)
+import Text.Megaparsec.Char.Lexer qualified as L
+
+space :: ParsecS r ()
+space = space' False void
+
+lexeme :: ParsecS r a -> ParsecS r a
+lexeme = L.lexeme space
+
+lexemeInterval :: Member (Reader ParserParams) r => ParsecS r a -> ParsecS r (a, Interval)
+lexemeInterval = lexeme . interval
+
+symbol :: Text -> ParsecS r ()
+symbol = void . L.symbol space
+
+decimal :: (Member (Reader ParserParams) r, Num n) => ParsecS r (n, Interval)
+decimal = lexemeInterval L.decimal
+
+integer :: Member (Reader ParserParams) r => ParsecS r (Integer, Interval)
+integer = integer' decimal
+
+number :: Member (Reader ParserParams) r => Int -> Int -> ParsecS r (Int, Interval)
+number = number' integer
+
+string :: ParsecS r Text
+string = string'
+
+boolean :: Member (Reader ParserParams) r => ParsecS r (Bool, Interval)
+boolean = interval (kwTrue >> return True) <|> interval (kwFalse >> return False)
+
+keyword :: Text -> ParsecS r ()
+keyword = void . keyword' space
+
+identifier :: ParsecS r Text
+identifier = lexeme bareIdentifier
+
+identifierL :: Member (Reader ParserParams) r => ParsecS r (Text, Interval)
+identifierL = lexemeInterval bareIdentifier
+
+-- | Same as @identifier@ but does not consume space after it.
+bareIdentifier :: ParsecS r Text
+bareIdentifier = rawIdentifier allKeywords
+
+allKeywords :: [ParsecS r ()]
+allKeywords =
+  [ kwAssignment,
+    kwColon,
+    kwLambda,
+    kwLet,
+    kwIn,
+    kwConstr,
+    kwCase,
+    kwOf,
+    kwIf,
+    kwThen,
+    kwElse,
+    kwTrue,
+    kwFalse,
+    kwDef,
+    kwMapsTo,
+    kwRightArrow,
+    kwSemicolon,
+    kwWildcard,
+    kwPlus,
+    kwMinus,
+    kwMul,
+    kwDiv,
+    kwEq,
+    kwLt,
+    kwLe,
+    kwGt,
+    kwGe
+  ]
+
+lbrace :: ParsecS r ()
+lbrace = symbol "{"
+
+rbrace :: ParsecS r ()
+rbrace = symbol "}"
+
+lparen :: ParsecS r ()
+lparen = symbol "("
+
+rparen :: ParsecS r ()
+rparen = symbol ")"
+
+parens :: ParsecS r a -> ParsecS r a
+parens = between lparen rparen
+
+braces :: ParsecS r a -> ParsecS r a
+braces = between (symbol "{") (symbol "}")
+
+kwAssignment :: ParsecS r ()
+kwAssignment = keyword Str.assignUnicode <|> keyword Str.assignAscii
+
+kwColon :: ParsecS r ()
+kwColon = keyword Str.colon
+
+kwInductive :: ParsecS r ()
+kwInductive = keyword Str.inductive
+
+kwLambda :: ParsecS r ()
+kwLambda = keyword Str.lambdaUnicode <|> keyword Str.lambdaAscii
+
+kwLet :: ParsecS r ()
+kwLet = keyword Str.let_
+
+kwIn :: ParsecS r ()
+kwIn = keyword Str.in_
+
+kwConstr :: ParsecS r ()
+kwConstr = keyword Str.constr
+
+kwCase :: ParsecS r ()
+kwCase = keyword Str.case_
+
+kwOf :: ParsecS r ()
+kwOf = keyword Str.of_
+
+kwIf :: ParsecS r ()
+kwIf = keyword Str.if_
+
+kwThen :: ParsecS r ()
+kwThen = keyword Str.then_
+
+kwElse :: ParsecS r ()
+kwElse = keyword Str.else_
+
+kwTrue :: ParsecS r ()
+kwTrue = keyword Str.true_
+
+kwFalse :: ParsecS r ()
+kwFalse = keyword Str.false_
+
+kwDef :: ParsecS r ()
+kwDef = keyword Str.def
+
+kwMapsTo :: ParsecS r ()
+kwMapsTo = keyword Str.mapstoUnicode <|> keyword Str.mapstoAscii
+
+kwRightArrow :: ParsecS r ()
+kwRightArrow = keyword Str.toUnicode <|> keyword Str.toAscii
+
+kwSemicolon :: ParsecS r ()
+kwSemicolon = keyword Str.semicolon
+
+kwWildcard :: ParsecS r ()
+kwWildcard = keyword Str.underscore
+
+kwPlus :: ParsecS r ()
+kwPlus = keyword Str.plus
+
+kwMinus :: ParsecS r ()
+kwMinus = keyword Str.minus
+
+kwMul :: ParsecS r ()
+kwMul = keyword Str.mul
+
+kwDiv :: ParsecS r ()
+kwDiv = keyword Str.div
+
+kwEq :: ParsecS r ()
+kwEq = keyword Str.equal
+
+kwLt :: ParsecS r ()
+kwLt = keyword Str.less
+
+kwLe :: ParsecS r ()
+kwLe = keyword Str.lessEqual
+
+kwGt :: ParsecS r ()
+kwGt = keyword Str.greater
+
+kwGe :: ParsecS r ()
+kwGe = keyword Str.greaterEqual
diff --git a/src/Juvix/Extra/Strings.hs b/src/Juvix/Extra/Strings.hs
index 713ba00b0f..9b0d353c79 100644
--- a/src/Juvix/Extra/Strings.hs
+++ b/src/Juvix/Extra/Strings.hs
@@ -41,6 +41,9 @@ function = "function"
 constructor :: IsString s => s
 constructor = "constructor"
 
+constr :: IsString s => s
+constr = "constr"
+
 topModule :: IsString s => s
 topModule = "top module"
 
@@ -134,6 +137,12 @@ less = "<"
 lessEqual :: IsString s => s
 lessEqual = "<="
 
+greater :: IsString s => s
+greater = ">"
+
+greaterEqual :: IsString s => s
+greaterEqual = ">="
+
 data_ :: IsString s => s
 data_ = "data"
 
@@ -239,6 +248,9 @@ sizeof = "sizeof"
 true_ :: IsString s => s
 true_ = "true"
 
+false_ :: IsString s => s
+false_ = "false"
+
 tag :: IsString s => s
 tag = "tag"
 
@@ -275,6 +287,9 @@ then_ = "then"
 else_ :: IsString s => s
 else_ = "else"
 
+def :: IsString s => s
+def = "def"
+
 zero :: IsString s => s
 zero = "0"
 
diff --git a/src/Juvix/Compiler/Concrete/Translation/FromSource/Error.hs b/src/Juvix/Parser/Error.hs
similarity index 88%
rename from src/Juvix/Compiler/Concrete/Translation/FromSource/Error.hs
rename to src/Juvix/Parser/Error.hs
index e0c2706231..c240e30c6d 100644
--- a/src/Juvix/Compiler/Concrete/Translation/FromSource/Error.hs
+++ b/src/Juvix/Parser/Error.hs
@@ -1,9 +1,9 @@
-module Juvix.Compiler.Concrete.Translation.FromSource.Error where
+module Juvix.Parser.Error where
 
-import Juvix.Compiler.Concrete.Extra (errorOffset)
 import Juvix.Prelude
 import Juvix.Prelude.Pretty
 import Text.Megaparsec qualified as M
+import Text.Megaparsec.Error (errorOffset)
 
 newtype ParserError = ParserError
   { _parseError :: M.ParseErrorBundle Text Void
diff --git a/src/Juvix/Parser/Lexer.hs b/src/Juvix/Parser/Lexer.hs
new file mode 100644
index 0000000000..bbd8292173
--- /dev/null
+++ b/src/Juvix/Parser/Lexer.hs
@@ -0,0 +1,114 @@
+module Juvix.Parser.Lexer where
+
+{-
+
+This module contains lexing functions common to all parsers in the pipeline
+(Juvix, JuvixCore, JuvixAsm).
+
+-}
+
+import Control.Monad.Trans.Class (lift)
+import Data.Set qualified as Set
+import Data.Text qualified as Text
+import GHC.Unicode
+import Juvix.Extra.Strings qualified as Str
+import Juvix.Prelude
+import Text.Megaparsec as P hiding (sepBy1, sepEndBy1, some)
+import Text.Megaparsec.Char hiding (space)
+import Text.Megaparsec.Char.Lexer qualified as L
+
+type ParsecS r = ParsecT Void Text (Sem r)
+
+newtype ParserParams = ParserParams
+  { _parserParamsRoot :: FilePath
+  }
+
+makeLenses ''ParserParams
+
+parseFailure :: String -> ParsecS r a
+parseFailure str = P.fancyFailure $ Set.singleton (P.ErrorFail str)
+
+space' :: forall r. Bool -> (forall a. ParsecS r a -> ParsecS r ()) -> ParsecS r ()
+space' judoc comment_ = L.space space1 lineComment block
+  where
+    lineComment :: ParsecS r ()
+    lineComment = comment_ $ do
+      when
+        judoc
+        (notFollowedBy (P.chunk Str.judocStart))
+      void (P.chunk "--")
+      void (P.takeWhileP Nothing (/= '\n'))
+
+    block :: ParsecS r ()
+    block = comment_ (L.skipBlockComment "{-" "-}")
+
+integer' :: ParsecS r (Integer, Interval) -> ParsecS r (Integer, Interval)
+integer' dec = do
+  minus <- optional (char '-')
+  (nat, i) <- dec
+  let nat' = case minus of
+        Nothing -> nat
+        _ -> (-nat)
+  return (nat', i)
+
+number' :: ParsecS r (Integer, Interval) -> Int -> Int -> ParsecS r (Int, Interval)
+number' int mn mx = do
+  (n, i) <- int
+  when
+    (n < fromIntegral mn || n > fromIntegral mx)
+    (parseFailure ("number out of bounds: " ++ show n))
+  return (fromInteger n, i)
+
+string' :: ParsecS r Text
+string' = pack <$> (char '"' >> manyTill L.charLiteral (char '"'))
+
+keyword' :: ParsecS r () -> Text -> ParsecS r ()
+keyword' spc kw = do
+  P.try $ do
+    P.chunk kw
+    notFollowedBy (satisfy validTailChar)
+    spc
+
+keywordL' :: Member (Reader ParserParams) r => ParsecS r () -> Text -> ParsecS r Interval
+keywordL' spc kw = do
+  P.try $ do
+    i <- snd <$> interval (P.chunk kw)
+    notFollowedBy (satisfy validTailChar)
+    spc
+    return i
+
+rawIdentifier :: [ParsecS r ()] -> ParsecS r Text
+rawIdentifier allKeywords = do
+  notFollowedBy (choice allKeywords)
+  h <- P.satisfy validFirstChar
+  t <- P.takeWhileP Nothing validTailChar
+  return (Text.cons h t)
+
+validTailChar :: Char -> Bool
+validTailChar c =
+  isAlphaNum c || validFirstChar c
+
+reservedSymbols :: [Char]
+reservedSymbols = "\";(){}[].≔λ\\"
+
+validFirstChar :: Char -> Bool
+validFirstChar c = not $ isNumber c || isSpace c || (c `elem` reservedSymbols)
+
+curLoc :: Member (Reader ParserParams) r => ParsecS r Loc
+curLoc = do
+  sp <- getSourcePos
+  offset <- getOffset
+  root <- lift (asks (^. parserParamsRoot))
+  return (mkLoc root offset sp)
+
+interval :: Member (Reader ParserParams) r => ParsecS r a -> ParsecS r (a, Interval)
+interval ma = do
+  start <- curLoc
+  res <- ma
+  end <- curLoc
+  return (res, mkInterval start end)
+
+withLoc :: Member (Reader ParserParams) r => ParsecS r a -> ParsecS r (WithLoc a)
+withLoc ma = do
+  (a, i) <- interval ma
+  return (WithLoc i a)

From 7c5fc674aa3748a9e8bca9eb76e03e17eb7f996c Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Wed, 10 Aug 2022 17:16:57 +0200
Subject: [PATCH 38/85] minor changes

---
 .../Compiler/Core/Data/InfoTableBuilder.hs    | 10 ++++
 src/Juvix/Compiler/Core/Extra/Recursors.hs    |  6 +-
 .../Compiler/Core/Language/Info/BranchInfo.hs |  2 +-
 src/Juvix/Compiler/Core/Language/Type.hs      |  1 -
 src/Juvix/Compiler/Core/Pretty/Base.hs        |  2 +-
 .../Compiler/Core/Translation/FromSource.hs   | 58 ++++++++++++++-----
 6 files changed, 59 insertions(+), 20 deletions(-)

diff --git a/src/Juvix/Compiler/Core/Data/InfoTableBuilder.hs b/src/Juvix/Compiler/Core/Data/InfoTableBuilder.hs
index 7e137beb03..1423ae24eb 100644
--- a/src/Juvix/Compiler/Core/Data/InfoTableBuilder.hs
+++ b/src/Juvix/Compiler/Core/Data/InfoTableBuilder.hs
@@ -23,6 +23,16 @@ hasIdent txt = do
     Just _ -> return True
     Nothing -> return False
 
+getConstructorInfo :: Member InfoTableBuilder r => Tag -> Sem r ConstructorInfo
+getConstructorInfo tag = do
+  tab <- getInfoTable
+  return $ fromJust (HashMap.lookup tag (tab ^. infoConstructors))
+
+checkSymbolDefined :: Member InfoTableBuilder r => Symbol -> Sem r Bool
+checkSymbolDefined sym = do
+  tab <- getInfoTable
+  return $ HashMap.member sym (tab ^. identContext)
+
 data BuilderState = BuilderState
   { _stateNextSymbol :: Word,
     _stateNextUserTag :: Word,
diff --git a/src/Juvix/Compiler/Core/Extra/Recursors.hs b/src/Juvix/Compiler/Core/Extra/Recursors.hs
index 2545148248..74e81bd4e5 100644
--- a/src/Juvix/Compiler/Core/Extra/Recursors.hs
+++ b/src/Juvix/Compiler/Core/Extra/Recursors.hs
@@ -171,10 +171,10 @@ walkN :: Monad m => (Index -> Node -> m ()) -> Node -> m ()
 walkN = ufoldMN mappend
 
 gather :: (a -> Node -> a) -> a -> Node -> a
-gather f acc n = run $ execState acc (walk (\n' -> modify (`f` n')) n)
+gather f acc n = run $ execState acc (walk (\n' -> modify' (`f` n')) n)
 
 gatherB :: (BinderList (Maybe BinderInfo) -> a -> Node -> a) -> a -> Node -> a
-gatherB f acc n = run $ execState acc (walkB (\is n' -> modify (\a -> f is a n')) n)
+gatherB f acc n = run $ execState acc (walkB (\is n' -> modify' (\a -> f is a n')) n)
 
 gatherN :: (Index -> a -> Node -> a) -> a -> Node -> a
-gatherN f acc n = run $ execState acc (walkN (\idx n' -> modify (\a -> f idx a n')) n)
+gatherN f acc n = run $ execState acc (walkN (\idx n' -> modify' (\a -> f idx a n')) n)
diff --git a/src/Juvix/Compiler/Core/Language/Info/BranchInfo.hs b/src/Juvix/Compiler/Core/Language/Info/BranchInfo.hs
index 6acad0dd5b..d19a5442be 100644
--- a/src/Juvix/Compiler/Core/Language/Info/BranchInfo.hs
+++ b/src/Juvix/Compiler/Core/Language/Info/BranchInfo.hs
@@ -3,7 +3,7 @@ module Juvix.Compiler.Core.Language.Info.BranchInfo where
 import Juvix.Compiler.Core.Language.Base
 
 newtype BranchInfo = BranchInfo
-  { _infoName :: Name
+  { _infoTagName :: Name
   }
 
 instance IsInfo BranchInfo
diff --git a/src/Juvix/Compiler/Core/Language/Type.hs b/src/Juvix/Compiler/Core/Language/Type.hs
index 6ebb1993ee..e7effb0dca 100644
--- a/src/Juvix/Compiler/Core/Language/Type.hs
+++ b/src/Juvix/Compiler/Core/Language/Type.hs
@@ -3,7 +3,6 @@ module Juvix.Compiler.Core.Language.Type where
 import Juvix.Compiler.Core.Language.Base
 
 -- Star (*) allows to specify the type partially, e.g.: * -> * -> *.
--- Star in the target is assumed to be an atom.
 data Type = Atomic Atom | Fun Type Type | Universe | Star
 
 data Atom = Atom
diff --git a/src/Juvix/Compiler/Core/Pretty/Base.hs b/src/Juvix/Compiler/Core/Pretty/Base.hs
index fb5c200438..18ed33f413 100644
--- a/src/Juvix/Compiler/Core/Pretty/Base.hs
+++ b/src/Juvix/Compiler/Core/Pretty/Base.hs
@@ -119,7 +119,7 @@ instance PrettyCode Node where
           Nothing -> mapM (\(CaseBranch _ n _) -> replicateM n (return kwQuestion)) caseBranches
       cns <-
         case Info.lookup kCaseBranchInfo caseInfo of
-          Just ci -> mapM (ppCode . (^. BranchInfo.infoName)) (ci ^. infoBranches)
+          Just ci -> mapM (ppCode . (^. BranchInfo.infoTagName)) (ci ^. infoBranches)
           Nothing -> mapM (\(CaseBranch tag _ _) -> ppCode tag) caseBranches
       let bs = map (\(CaseBranch _ _ br) -> br) caseBranches
       v <- ppCode caseValue
diff --git a/src/Juvix/Compiler/Core/Translation/FromSource.hs b/src/Juvix/Compiler/Core/Translation/FromSource.hs
index b02a451d05..99cce868e2 100644
--- a/src/Juvix/Compiler/Core/Translation/FromSource.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromSource.hs
@@ -9,6 +9,7 @@ import Juvix.Compiler.Core.Extra.Base
 import Juvix.Compiler.Core.Language
 import Juvix.Compiler.Core.Language.Info qualified as Info
 import Juvix.Compiler.Core.Language.Info.BinderInfo as BinderInfo
+import Juvix.Compiler.Core.Language.Info.BranchInfo as BranchInfo
 import Juvix.Compiler.Core.Language.Info.LocationInfo as LocationInfo
 import Juvix.Compiler.Core.Language.Info.NameInfo as NameInfo
 import Juvix.Compiler.Core.Language.Type
@@ -35,7 +36,7 @@ runParser root fileName tab input =
         }
 
 freshName ::
-  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Members '[InfoTableBuilder, NameIdGen] r =>
   NameKind ->
   Text ->
   Interval ->
@@ -51,6 +52,15 @@ freshName kind txt i = do
         _nameLoc = i
       }
 
+guardSymbolNotDefined ::
+  Member InfoTableBuilder r =>
+  Symbol ->
+  ParsecS r () ->
+  ParsecS r ()
+guardSymbolNotDefined sym err = do
+  b <- lift $ checkSymbolDefined sym
+  when b err
+
 parseToplevel ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
   ParsecS r (Maybe Node)
@@ -73,9 +83,8 @@ statementDef = do
   r <- lift (getIdent txt)
   case r of
     Just (Left sym) -> do
-      tab <- lift getInfoTable
-      when
-        (HashMap.member sym (tab ^. identContext))
+      guardSymbolNotDefined
+        sym
         (parseFailure ("duplicate definition of: " ++ fromText txt))
       parseDefinition sym
     Just (Right {}) ->
@@ -165,7 +174,12 @@ cmpExpr' ::
   Node ->
   ParsecS r Node
 cmpExpr' varsNum vars node =
-  eqExpr' varsNum vars node <|> ltExpr' varsNum vars node <|> leExpr' varsNum vars node <|> return node
+  eqExpr' varsNum vars node
+    <|> ltExpr' varsNum vars node
+    <|> leExpr' varsNum vars node
+    <|> gtExpr' varsNum vars node
+    <|> geExpr' varsNum vars node
+    <|> return node
 
 eqExpr' ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
@@ -236,7 +250,9 @@ arithExpr' ::
   Node ->
   ParsecS r Node
 arithExpr' varsNum vars node =
-  plusExpr' varsNum vars node <|> minusExpr' varsNum vars node <|> return node
+  plusExpr' varsNum vars node
+    <|> minusExpr' varsNum vars node
+    <|> return node
 
 plusExpr' ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
@@ -274,7 +290,9 @@ multExpr' ::
   Node ->
   ParsecS r Node
 multExpr' varsNum vars node =
-  mulExpr' varsNum vars node <|> divExpr' varsNum vars node <|> return node
+  mulExpr' varsNum vars node
+    <|> divExpr' varsNum vars node
+    <|> return node
 
 mulExpr' ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
@@ -443,12 +461,24 @@ exprCase' value varsNum vars = do
   bs <- P.sepEndBy (caseBranch varsNum vars) kwSemicolon
   rbrace
   let bs' = map fromLeft' $ filter isLeft bs
+  let bss = map fst bs'
+  let bsns = map snd bs'
   let def' = map fromRight' $ filter isRight bs
+  let bi = CaseBinderInfo $ map (map (`BinderInfo` Star)) bsns
+  bri <-
+    CaseBranchInfo
+      <$> mapM
+        ( \(CaseBranch tag _ _) -> do
+            ci <- lift $ getConstructorInfo tag
+            return $ BranchInfo (ci ^. constructorName)
+        )
+        bss
+  let info = Info.insert bri (Info.singleton bi)
   case def' of
     [def] ->
-      return $ Case Info.empty value bs' (Just def)
+      return $ Case info value bss (Just def)
     [] ->
-      return $ Case Info.empty value bs' Nothing
+      return $ Case info value bss Nothing
     _ ->
       parseFailure "multiple default branches"
 
@@ -456,7 +486,7 @@ caseBranch ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
   Index ->
   HashMap Text Index ->
-  ParsecS r (Either CaseBranch Node)
+  ParsecS r (Either (CaseBranch, [Name]) Node)
 caseBranch varsNum vars =
   (defaultBranch varsNum vars <&> Right)
     <|> (matchingBranch varsNum vars <&> Left)
@@ -475,7 +505,7 @@ matchingBranch ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
   Index ->
   HashMap Text Index ->
-  ParsecS r CaseBranch
+  ParsecS r (CaseBranch, [Name])
 matchingBranch varsNum vars = do
   txt <- identifier
   r <- lift (getIdent txt)
@@ -485,9 +515,9 @@ matchingBranch varsNum vars = do
     Just (Right tag) -> do
       ns <- P.many parseLocalName
       let bindersNum = length ns
-      tab <- lift getInfoTable
+      ci <- lift $ getConstructorInfo tag
       when
-        (fromJust (HashMap.lookup tag (tab ^. infoConstructors)) ^. constructorArgsNum /= bindersNum)
+        (ci ^. constructorArgsNum /= bindersNum)
         (parseFailure "wrong number of constructor arguments")
       kwMapsTo
       let vars' =
@@ -499,7 +529,7 @@ matchingBranch varsNum vars = do
                 (vars, varsNum)
                 ns
       br <- expr (varsNum + bindersNum) vars'
-      return $ CaseBranch tag bindersNum br
+      return (CaseBranch tag bindersNum br, ns)
     Nothing ->
       parseFailure ("undeclared identifier: " ++ fromText txt)
 

From 0163e1f479b5751d41606454a3ad836e96c09184 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Wed, 10 Aug 2022 17:21:24 +0200
Subject: [PATCH 39/85] minor refactor

---
 .../Compiler/Core/Translation/FromSource.hs    | 18 +++++++++---------
 1 file changed, 9 insertions(+), 9 deletions(-)

diff --git a/src/Juvix/Compiler/Core/Translation/FromSource.hs b/src/Juvix/Compiler/Core/Translation/FromSource.hs
index 99cce868e2..2ab80b0cc9 100644
--- a/src/Juvix/Compiler/Core/Translation/FromSource.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromSource.hs
@@ -241,7 +241,7 @@ arithExpr ::
   Index ->
   HashMap Text Index ->
   ParsecS r Node
-arithExpr varsNum vars = multExpr varsNum vars >>= arithExpr' varsNum vars
+arithExpr varsNum vars = factorExpr varsNum vars >>= arithExpr' varsNum vars
 
 arithExpr' ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
@@ -262,7 +262,7 @@ plusExpr' ::
   ParsecS r Node
 plusExpr' varsNum vars node = do
   kwPlus
-  node' <- multExpr varsNum vars
+  node' <- factorExpr varsNum vars
   arithExpr' varsNum vars (BuiltinApp Info.empty OpIntAdd [node, node'])
 
 minusExpr' ::
@@ -273,23 +273,23 @@ minusExpr' ::
   ParsecS r Node
 minusExpr' varsNum vars node = do
   kwMinus
-  node' <- multExpr varsNum vars
+  node' <- factorExpr varsNum vars
   arithExpr' varsNum vars (BuiltinApp Info.empty OpIntSub [node, node'])
 
-multExpr ::
+factorExpr ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
   Index ->
   HashMap Text Index ->
   ParsecS r Node
-multExpr varsNum vars = appExpr varsNum vars >>= multExpr' varsNum vars
+factorExpr varsNum vars = appExpr varsNum vars >>= factorExpr' varsNum vars
 
-multExpr' ::
+factorExpr' ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
   Index ->
   HashMap Text Index ->
   Node ->
   ParsecS r Node
-multExpr' varsNum vars node =
+factorExpr' varsNum vars node =
   mulExpr' varsNum vars node
     <|> divExpr' varsNum vars node
     <|> return node
@@ -303,7 +303,7 @@ mulExpr' ::
 mulExpr' varsNum vars node = do
   kwMul
   node' <- appExpr varsNum vars
-  multExpr' varsNum vars (BuiltinApp Info.empty OpIntMul [node, node'])
+  factorExpr' varsNum vars (BuiltinApp Info.empty OpIntMul [node, node'])
 
 divExpr' ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
@@ -314,7 +314,7 @@ divExpr' ::
 divExpr' varsNum vars node = do
   kwDiv
   node' <- appExpr varsNum vars
-  multExpr' varsNum vars (BuiltinApp Info.empty OpIntDiv [node, node'])
+  factorExpr' varsNum vars (BuiltinApp Info.empty OpIntDiv [node, node'])
 
 appExpr ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>

From 97f3be2ee0575bc2bd6db080d1df34c057d886b1 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Wed, 10 Aug 2022 17:22:49 +0200
Subject: [PATCH 40/85] minor refactor

---
 src/Juvix/Compiler/Core/Translation/FromSource.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Juvix/Compiler/Core/Translation/FromSource.hs b/src/Juvix/Compiler/Core/Translation/FromSource.hs
index 2ab80b0cc9..ca85a64cc7 100644
--- a/src/Juvix/Compiler/Core/Translation/FromSource.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromSource.hs
@@ -155,7 +155,9 @@ expression = expr 0 mempty
 
 expr ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  -- current de Bruijn index, i.e., the number of binders upwards
   Index ->
+  -- reverse de Bruijn indices
   HashMap Text Index ->
   ParsecS r Node
 expr varsNum vars = cmpExpr varsNum vars
@@ -351,9 +353,7 @@ atoms varsNum vars = do
 
 atom ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
-  -- current de Bruijn index, i.e., the number of binders upwards
   Index ->
-  -- reverse de Bruijn indices
   HashMap Text Index ->
   ParsecS r Node
 atom varsNum vars =

From 1ae96644b972ac2b7259fd19a00cfdbc5b7b9fb3 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Thu, 11 Aug 2022 12:51:02 +0200
Subject: [PATCH 41/85] JuvixCore evaluator CLI

---
 app/App.hs                                    |   8 +-
 app/Commands/Dev.hs                           |  11 ++
 app/Commands/Dev/Core.hs                      |  55 +++++++++
 app/Main.hs                                   | 108 ++++++++++++++++++
 src/Juvix/Compiler/Core/Error.hs              |  31 +++++
 src/Juvix/Compiler/Core/Evaluator.hs          |  98 ++++++++++------
 src/Juvix/Compiler/Core/Extra.hs              |   9 +-
 src/Juvix/Compiler/Core/Extra/Info.hs         |  22 ++++
 src/Juvix/Compiler/Core/Language/Info.hs      |   2 +-
 src/Juvix/Compiler/Core/Pretty.hs             |   1 +
 src/Juvix/Compiler/Core/Pretty/Base.hs        |  20 ++--
 .../Compiler/Core/Translation/FromSource.hs   |   4 +-
 .../Core/Translation/FromSource/Lexer.hs      |   7 +-
 src/Juvix/Parser/Lexer.hs                     |   6 +
 14 files changed, 330 insertions(+), 52 deletions(-)
 create mode 100644 app/Commands/Dev/Core.hs
 create mode 100644 src/Juvix/Compiler/Core/Error.hs
 create mode 100644 src/Juvix/Compiler/Core/Extra/Info.hs

diff --git a/app/App.hs b/app/App.hs
index 7455690f87..359bf2a2b5 100644
--- a/app/App.hs
+++ b/app/App.hs
@@ -11,6 +11,7 @@ import System.Console.ANSI qualified as Ansi
 data App m a where
   ExitMsg :: ExitCode -> Text -> App m ()
   ExitJuvixError :: JuvixError -> App m a
+  PrintJuvixError :: JuvixError -> App m ()
   ReadGlobalOptions :: App m GlobalOptions
   RenderStdOut :: (HasAnsiBackend a, HasTextBackend a) => a -> App m ()
   RunPipelineEither :: Sem PipelineEff a -> App m (Either JuvixError a)
@@ -31,11 +32,16 @@ runAppIO g = interpret $ \case
   Say t
     | g ^. globalOnlyErrors -> return ()
     | otherwise -> embed (putStrLn t)
+  PrintJuvixError e -> do
+    printErr e
   ExitJuvixError e -> do
-    (embed . hPutStrLn stderr . Error.render (not (g ^. globalNoColors)) (g ^. globalOnlyErrors)) e
+    printErr e
     embed exitFailure
   ExitMsg exitCode t -> embed (putStrLn t >> exitWith exitCode)
   Raw b -> embed (ByteString.putStr b)
+  where
+    printErr e =
+      (embed . hPutStrLn stderr . Error.render (not (g ^. globalNoColors)) (g ^. globalOnlyErrors)) e
 
 runPipeline :: Member App r => Sem PipelineEff a -> Sem r a
 runPipeline p = do
diff --git a/app/Commands/Dev.hs b/app/Commands/Dev.hs
index 720f6230e6..2522902362 100644
--- a/app/Commands/Dev.hs
+++ b/app/Commands/Dev.hs
@@ -1,5 +1,6 @@
 module Commands.Dev
   ( module Commands.Dev,
+    module Commands.Dev.Core,
     module Commands.Dev.Internal,
     module Commands.Dev.Parse,
     module Commands.Dev.Scope,
@@ -8,6 +9,7 @@ module Commands.Dev
   )
 where
 
+import Commands.Dev.Core
 import Commands.Dev.Doc
 import Commands.Dev.Internal
 import Commands.Dev.Parse
@@ -21,6 +23,7 @@ data InternalCommand
   = DisplayRoot
   | Highlight HighlightOptions
   | Internal MicroCommand
+  | Core CoreCommand
   | MiniC
   | MiniHaskell
   | MonoJuvix
@@ -39,6 +42,7 @@ parseInternalCommand =
     ( mconcat
         [ commandHighlight,
           commandInternal,
+          commandCore,
           commandMiniC,
           commandMiniHaskell,
           commandMonoJuvix,
@@ -96,6 +100,13 @@ commandInternal =
       (Internal <$> parseMicroCommand)
       (progDesc "Subcommands related to Internal")
 
+commandCore :: Mod CommandFields InternalCommand
+commandCore =
+  command "core" $
+    info
+      (Core <$> parseCoreCommand)
+      (progDesc "Subcommands related to JuvixCore")
+
 commandMiniHaskell :: Mod CommandFields InternalCommand
 commandMiniHaskell =
   command "minihaskell" $
diff --git a/app/Commands/Dev/Core.hs b/app/Commands/Dev/Core.hs
new file mode 100644
index 0000000000..22bcd63a9a
--- /dev/null
+++ b/app/Commands/Dev/Core.hs
@@ -0,0 +1,55 @@
+module Commands.Dev.Core where
+
+import Juvix.Prelude hiding (Doc)
+import Options.Applicative
+
+data CoreCommand
+  = Repl CoreEvalOptions
+  | Eval CoreEvalOptions
+
+newtype CoreEvalOptions = CoreEvalOptions
+  { _coreEvalNoIO :: Bool
+  }
+
+makeLenses ''CoreEvalOptions
+
+defaultCoreEvalOptions :: CoreEvalOptions
+defaultCoreEvalOptions =
+  CoreEvalOptions
+    { _coreEvalNoIO = False
+    }
+
+parseCoreCommand :: Parser CoreCommand
+parseCoreCommand =
+  hsubparser $
+    mconcat
+      [ commandRepl,
+        commandEval
+      ]
+  where
+    commandRepl :: Mod CommandFields CoreCommand
+    commandRepl = command "repl" replInfo
+
+    commandEval :: Mod CommandFields CoreCommand
+    commandEval = command "eval" evalInfo
+
+    replInfo :: ParserInfo CoreCommand
+    replInfo =
+      info
+        (Repl <$> parseCoreEvalOptions)
+        (progDesc "Start an interactive session of the JuvixCore evaluator")
+
+    evalInfo :: ParserInfo CoreCommand
+    evalInfo =
+      info
+        (Eval <$> parseCoreEvalOptions)
+        (progDesc "Evaluate a JuvixCore file and pretty print the result")
+
+parseCoreEvalOptions :: Parser CoreEvalOptions
+parseCoreEvalOptions = do
+  _coreEvalNoIO <-
+    switch
+      ( long "no-io"
+          <> help "Don't interpret the IO effects"
+      )
+  pure CoreEvalOptions {..}
diff --git a/app/Main.hs b/app/Main.hs
index c691077d7f..8c45e1aac5 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -23,6 +23,12 @@ import Juvix.Compiler.Concrete.Data.InfoTable qualified as Scoper
 import Juvix.Compiler.Concrete.Pretty qualified as Scoper
 import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping qualified as Scoper
 import Juvix.Compiler.Concrete.Translation.FromSource qualified as Parser
+import Juvix.Compiler.Core.Data.InfoTable qualified as Core
+import Juvix.Compiler.Core.Error qualified as Core
+import Juvix.Compiler.Core.Evaluator qualified as Core
+import Juvix.Compiler.Core.Language qualified as Core
+import Juvix.Compiler.Core.Pretty qualified as Core
+import Juvix.Compiler.Core.Translation.FromSource qualified as Core
 import Juvix.Compiler.Internal.Pretty qualified as Internal
 import Juvix.Compiler.Internal.Translation.FromAbstract qualified as Internal
 import Juvix.Compiler.Internal.Translation.FromAbstract.Analysis.Termination qualified as Termination
@@ -39,6 +45,7 @@ import Juvix.Prelude.Pretty hiding (Doc)
 import Options.Applicative
 import System.Environment (getProgName)
 import System.Process qualified as Process
+import Text.Megaparsec.Pos qualified as M
 import Text.Show.Pretty hiding (Html)
 
 findRoot :: CommandGlobalOptions -> IO (FilePath, Package)
@@ -103,6 +110,7 @@ runCommand cmdWithOpts = do
   (root, pkg) <- embed (findRoot cmdWithOpts)
   case cmd of
     (Dev DisplayRoot) -> say (pack root)
+    (Dev (Core cmd')) -> runCoreCommand globalOpts cmd'
     _ -> do
       -- Other commands require an entry point:
       case getEntryPoint root pkg globalOpts of
@@ -264,6 +272,106 @@ runCommand cmdWithOpts = do
                                 printSuccessExit (n <> " Terminates with order " <> show (toList k))
                 _ -> impossible
 
+runCoreCommand :: Members '[Embed IO, App] r => GlobalOptions -> CoreCommand -> Sem r ()
+runCoreCommand globalOpts = \case
+  Repl opts -> do
+    embed showReplWelcome
+    runRepl opts Core.emptyInfoTable
+  Eval _ ->
+    case globalOpts ^. globalInputFiles of
+      [] -> printFailureExit "Provide a JuvixCore file to run this command\nUse --help to see all the options"
+      files -> mapM_ evalFile files
+  where
+    runRepl ::
+      Members '[Embed IO, App] r =>
+      CoreEvalOptions ->
+      Core.InfoTable ->
+      Sem r ()
+    runRepl opts tab = do
+      embed (putStr "> ")
+      embed (hFlush stdout)
+      done <- embed isEOF
+      unless done $ do
+        s <- embed getLine
+        case fromText (strip s) of
+          ":q" -> return ()
+          ":h" -> do
+            embed showReplHelp
+            runRepl opts tab
+          ':' : 'p' : ' ' : s' ->
+            case Core.parseText tab (fromString s') of
+              Left err -> do
+                printJuvixError (JuvixError err)
+                runRepl opts tab
+              Right (tab', Just node) -> do
+                renderStdOut (Core.ppOutDefault node)
+                embed (putStrLn "")
+                runRepl opts tab'
+              Right (tab', Nothing) ->
+                runRepl opts tab'
+          _ ->
+            case Core.parseText tab s of
+              Left err -> do
+                printJuvixError (JuvixError err)
+                runRepl opts tab
+              Right (tab', Just node) -> do
+                r <- doEval defaultLoc tab' node
+                case r of
+                  Left err -> do
+                    printJuvixError (JuvixError err)
+                    runRepl opts tab'
+                  Right node' -> do
+                    renderStdOut (Core.ppOutDefault node')
+                    embed (putStrLn "")
+                    runRepl opts tab'
+              Right (tab', Nothing) ->
+                runRepl opts tab'
+      where
+        defaultLoc = singletonInterval (mkLoc "stdin" 0 (M.initialPos "stdin"))
+
+    showReplWelcome :: IO ()
+    showReplWelcome = do
+      putStrLn "JuvixCore REPL"
+      putStrLn ""
+      putStrLn "Type \":h\" for help."
+      putStrLn ""
+
+    showReplHelp :: IO ()
+    showReplHelp = do
+      putStrLn ""
+      putStrLn "JuvixCore REPL"
+      putStrLn ""
+      putStrLn "Type in a JuvixCore program to evaluate."
+      putStrLn "Type \":q\" to quit."
+      putStrLn "Type \":p expr\" to pretty print \"expr\"."
+      putStrLn "Type \":h\" to display this help message."
+      putStrLn ""
+
+    evalFile :: Members '[Embed IO, App] r => FilePath -> Sem r ()
+    evalFile f = do
+      s <- embed (readFile f)
+      case Core.runParser "" f Core.emptyInfoTable s of
+        Left err -> exitJuvixError (JuvixError err)
+        Right (tab, Just node) -> do
+          r <- doEval defaultLoc tab node
+          case r of
+            Left err -> exitJuvixError (JuvixError err)
+            Right node' -> do
+              renderStdOut (Core.ppOutDefault node')
+              embed (putStrLn "")
+        Right (_, Nothing) -> return ()
+      where
+        defaultLoc = singletonInterval (mkLoc f 0 (M.initialPos f))
+
+    doEval ::
+      Members '[Embed IO, App] r =>
+      Interval ->
+      Core.InfoTable ->
+      Core.Node ->
+      Sem r (Either Core.CoreError Core.Node)
+    doEval loc tab node =
+      embed (Core.catchEvalError loc (Core.eval (tab ^. Core.identContext) [] node))
+
 showHelpText :: ParserPrefs -> IO ()
 showHelpText p = do
   progn <- getProgName
diff --git a/src/Juvix/Compiler/Core/Error.hs b/src/Juvix/Compiler/Core/Error.hs
new file mode 100644
index 0000000000..eafaf28118
--- /dev/null
+++ b/src/Juvix/Compiler/Core/Error.hs
@@ -0,0 +1,31 @@
+module Juvix.Compiler.Core.Error where
+
+import Juvix.Compiler.Core.Language
+import Juvix.Compiler.Core.Pretty
+import Juvix.Prelude.Pretty
+
+data CoreError = CoreError
+  { _coreErrorMsg :: Text,
+    _coreErrorNode :: Maybe Node,
+    _coreErrorLoc :: Location
+  }
+
+makeLenses ''CoreError
+
+instance ToGenericError CoreError where
+  genericError e =
+    GenericError
+      { _genericErrorLoc = i,
+        _genericErrorMessage = AnsiText $ pretty @_ @AnsiStyle e,
+        _genericErrorIntervals = [i]
+      }
+    where
+      i = getLoc e
+
+instance Pretty CoreError where
+  pretty (CoreError {..}) = case _coreErrorNode of
+    Just node -> pretty _coreErrorMsg <> colon <> line <> pretty (ppOutDefault node)
+    Nothing -> pretty _coreErrorMsg
+
+instance HasLoc CoreError where
+  getLoc (CoreError {..}) = _coreErrorLoc
diff --git a/src/Juvix/Compiler/Core/Evaluator.hs b/src/Juvix/Compiler/Core/Evaluator.hs
index a1d7ba7b41..17e79afeab 100644
--- a/src/Juvix/Compiler/Core/Evaluator.hs
+++ b/src/Juvix/Compiler/Core/Evaluator.hs
@@ -7,26 +7,38 @@
 module Juvix.Compiler.Core.Evaluator where
 
 import Control.Exception qualified as Exception
-import Data.HashMap.Strict ((!))
+import Data.HashMap.Strict qualified as HashMap
 import GHC.Show
 import Juvix.Compiler.Core.Data.InfoTable
+import Juvix.Compiler.Core.Error
 import Juvix.Compiler.Core.Extra
 import Juvix.Compiler.Core.Language
 import Juvix.Compiler.Core.Language.Info qualified as Info
+import Juvix.Compiler.Core.Pretty
 
-newtype EvalError = EvalError String
+data EvalError = EvalError
+  { _evalErrorMsg :: Text,
+    _evalErrorNode :: Node
+  }
+
+makeLenses ''EvalError
 
 instance Show EvalError where
   show :: EvalError -> String
-  show (EvalError msg) = "evaluation error: " ++ msg
-
-instance Exception.Exception EvalError
+  show (EvalError {..}) =
+    "evaluation error: "
+      ++ fromText _evalErrorMsg
+      ++ ": "
+      ++ fromText (ppTrace _evalErrorNode)
 
 -- We definitely do _not_ want to wrap the evaluator in an exception monad / the
--- polysemy effects! This would almost double the execution time. Evaluation
--- errors should not happen for well-typed input (except perhaps division by
--- zero), so it is reasonable to catch them only at the CLI toplevel and just
--- exit when they occur.
+-- polysemy effects! This would almost double the execution time (whether an
+-- error occurred needs to be checked at every point). Evaluation errors should
+-- not happen for well-typed input (except perhaps division by zero), so it is
+-- reasonable to catch them only at the CLI toplevel and just exit when they
+-- occur. Use `catchEvalError` to catch evaluation errors in the IO monad.
+
+instance Exception.Exception EvalError
 
 -- `eval ctx env n` evalues a node `n` whose all free variables point into
 -- `env`. All nodes in `ctx` must be closed. All nodes in `env` must be values.
@@ -34,13 +46,13 @@ instance Exception.Exception EvalError
 eval :: IdentContext -> Env -> Node -> Node
 eval !ctx !env0 = convertRuntimeNodes . eval' env0
   where
-    evalError :: String -> a
-    evalError msg = Exception.throw (EvalError msg)
+    evalError :: Text -> Node -> a
+    evalError msg node = Exception.throw (EvalError msg node)
 
     eval' :: Env -> Node -> Node
     eval' !env !n = case n of
       Var _ idx -> env !! idx
-      Ident _ sym -> eval' [] (ctx ! sym)
+      Ident _ sym -> eval' [] (lookupContext n sym)
       Constant {} -> n
       Axiom {} -> n
       App _ l r ->
@@ -48,41 +60,41 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
           Closure _ env' b -> let !v = eval' env r in eval' (v : env') b
           a@(Axiom {}) -> Suspended Info.empty (App Info.empty a (eval' env r))
           Suspended i t -> Suspended i (App Info.empty t (eval' env r))
-          _ -> evalError "invalid application"
-      BuiltinApp _ op args -> applyBuiltin env op args
+          v -> evalError "invalid application" v
+      BuiltinApp _ op args -> applyBuiltin n env op args
       ConstrApp i tag args -> Data i tag (map (eval' env) args)
       Lambda i b -> Closure i env b
       Let _ v b -> let !v' = eval' env v in eval' (v' : env) b
       Case _ v bs def ->
         case eval' env v of
-          Data _ tag args -> branch env (args ++ env) tag def bs
-          _ -> evalError "matching on non-data"
+          Data _ tag args -> branch n env (args ++ env) tag def bs
+          v' -> evalError "matching on non-data" v'
       If _ v b1 b2 ->
         case eval' env v of
           Constant _ (ConstBool True) -> eval' env b1
           Constant _ (ConstBool False) -> eval' env b2
-          _ -> evalError "conditional branch on a non-boolean"
+          v' -> evalError "conditional branch on a non-boolean" v'
       Data {} -> n
       Closure {} -> n
       Suspended {} -> n
 
-    branch :: Env -> Env -> Tag -> Maybe Node -> [CaseBranch] -> Node
-    branch !denv !env !tag !def = \case
+    branch :: Node -> Env -> Env -> Tag -> Maybe Node -> [CaseBranch] -> Node
+    branch n !denv !env !tag !def = \case
       (CaseBranch tag' _ b) : _ | tag' == tag -> eval' env b
-      _ : bs' -> branch denv env tag def bs'
+      _ : bs' -> branch n denv env tag def bs'
       [] -> case def of
         Just b -> eval' denv b
-        Nothing -> evalError "no matching case branch"
-
-    applyBuiltin :: Env -> BuiltinOp -> [Node] -> Node
-    applyBuiltin env OpIntAdd [l, r] = nodeFromInteger (integerFromNode (eval' env l) + integerFromNode (eval' env r))
-    applyBuiltin env OpIntSub [l, r] = nodeFromInteger (integerFromNode (eval' env l) - integerFromNode (eval' env r))
-    applyBuiltin env OpIntMul [l, r] = nodeFromInteger (integerFromNode (eval' env l) * integerFromNode (eval' env r))
-    applyBuiltin env OpIntDiv [l, r] = nodeFromInteger (div (integerFromNode (eval' env l)) (integerFromNode (eval' env r)))
-    applyBuiltin env OpIntEq [l, r] = nodeFromBool (integerFromNode (eval' env l) == integerFromNode (eval' env r))
-    applyBuiltin env OpIntLt [l, r] = nodeFromBool (integerFromNode (eval' env l) < integerFromNode (eval' env r))
-    applyBuiltin env OpIntLe [l, r] = nodeFromBool (integerFromNode (eval' env l) <= integerFromNode (eval' env r))
-    applyBuiltin _ _ _ = evalError "invalid builtin application"
+        Nothing -> evalError "no matching case branch" (substEnv denv n)
+
+    applyBuiltin :: Node -> Env -> BuiltinOp -> [Node] -> Node
+    applyBuiltin _ env OpIntAdd [l, r] = nodeFromInteger (integerFromNode (eval' env l) + integerFromNode (eval' env r))
+    applyBuiltin _ env OpIntSub [l, r] = nodeFromInteger (integerFromNode (eval' env l) - integerFromNode (eval' env r))
+    applyBuiltin _ env OpIntMul [l, r] = nodeFromInteger (integerFromNode (eval' env l) * integerFromNode (eval' env r))
+    applyBuiltin _ env OpIntDiv [l, r] = nodeFromInteger (div (integerFromNode (eval' env l)) (integerFromNode (eval' env r)))
+    applyBuiltin _ env OpIntEq [l, r] = nodeFromBool (integerFromNode (eval' env l) == integerFromNode (eval' env r))
+    applyBuiltin _ env OpIntLt [l, r] = nodeFromBool (integerFromNode (eval' env l) < integerFromNode (eval' env r))
+    applyBuiltin _ env OpIntLe [l, r] = nodeFromBool (integerFromNode (eval' env l) <= integerFromNode (eval' env r))
+    applyBuiltin n env _ _ = evalError "invalid builtin application" (substEnv env n)
 
     nodeFromInteger :: Integer -> Node
     nodeFromInteger !int = Constant Info.empty (ConstInteger int)
@@ -93,4 +105,26 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
     integerFromNode :: Node -> Integer
     integerFromNode = \case
       Constant _ (ConstInteger int) -> int
-      _ -> evalError "not an integer"
+      v -> evalError "not an integer" v
+
+    lookupContext :: Node -> Symbol -> Node
+    lookupContext n sym =
+      case HashMap.lookup sym ctx of
+        Just n' -> n'
+        Nothing -> Suspended Info.empty n
+
+-- Catch EvalError and convert it to CoreError. Needs a default location in case
+-- no location is available in EvalError.
+catchEvalError :: Location -> a -> IO (Either CoreError a)
+catchEvalError loc a = do
+  Exception.catch
+    (return (Right a))
+    (\(ex :: EvalError) -> return (Left (toCoreError ex)))
+  where
+    toCoreError :: EvalError -> CoreError
+    toCoreError (EvalError {..}) =
+      CoreError
+        { _coreErrorMsg = _evalErrorMsg,
+          _coreErrorNode = Just _evalErrorNode,
+          _coreErrorLoc = fromMaybe loc (lookupLocation _evalErrorNode)
+        }
diff --git a/src/Juvix/Compiler/Core/Extra.hs b/src/Juvix/Compiler/Core/Extra.hs
index 52ca3380e3..ebd6a8a931 100644
--- a/src/Juvix/Compiler/Core/Extra.hs
+++ b/src/Juvix/Compiler/Core/Extra.hs
@@ -2,14 +2,15 @@ module Juvix.Compiler.Core.Extra
   ( module Juvix.Compiler.Core.Extra,
     module Juvix.Compiler.Core.Extra.Base,
     module Juvix.Compiler.Core.Extra.Recursors,
+    module Juvix.Compiler.Core.Extra.Info,
   )
 where
 
 import Data.HashSet qualified as HashSet
 import Juvix.Compiler.Core.Extra.Base
+import Juvix.Compiler.Core.Extra.Info
 import Juvix.Compiler.Core.Extra.Recursors
 import Juvix.Compiler.Core.Language
-import Juvix.Compiler.Core.Language.Info qualified as Info
 
 -- `isClosed` may short-circuit evaluation due to the use of `&&`, so it's not
 -- entirely reducible to `getFreeVars` in terms of computation time.
@@ -125,9 +126,3 @@ etaExpandConstrs argsNum = umap go
         | argsNum constrTag > length constrArgs ->
             etaExpand (argsNum constrTag - length constrArgs) n
       _ -> n
-
-mapInfo :: (Info -> Info) -> Node -> Node
-mapInfo f = umap (modifyInfo f)
-
-removeInfo :: IsInfo i => Key i -> Node -> Node
-removeInfo k = mapInfo (Info.delete k)
diff --git a/src/Juvix/Compiler/Core/Extra/Info.hs b/src/Juvix/Compiler/Core/Extra/Info.hs
new file mode 100644
index 0000000000..8df0a15925
--- /dev/null
+++ b/src/Juvix/Compiler/Core/Extra/Info.hs
@@ -0,0 +1,22 @@
+module Juvix.Compiler.Core.Extra.Info where
+
+import Juvix.Compiler.Core.Extra.Base
+import Juvix.Compiler.Core.Extra.Recursors
+import Juvix.Compiler.Core.Language
+import Juvix.Compiler.Core.Language.Info qualified as Info
+import Juvix.Compiler.Core.Language.Info.LocationInfo
+import Juvix.Compiler.Core.Language.Info.NameInfo
+
+mapInfo :: (Info -> Info) -> Node -> Node
+mapInfo f = umap (modifyInfo f)
+
+removeInfo :: IsInfo i => Key i -> Node -> Node
+removeInfo k = mapInfo (Info.delete k)
+
+lookupLocation :: Node -> Maybe Location
+lookupLocation node =
+  case Info.lookup kLocationInfo (getInfo node) of
+    Just li -> Just (li ^. infoLocation)
+    Nothing -> case Info.lookup kNameInfo (getInfo node) of
+      Just ni -> Just $ ni ^. (infoName . nameLoc)
+      Nothing -> Nothing
diff --git a/src/Juvix/Compiler/Core/Language/Info.hs b/src/Juvix/Compiler/Core/Language/Info.hs
index 22164f3148..5e48516ffb 100644
--- a/src/Juvix/Compiler/Core/Language/Info.hs
+++ b/src/Juvix/Compiler/Core/Language/Info.hs
@@ -30,7 +30,7 @@ member k i = HashMap.member (typeRep k) (i ^. infoMap)
 
 lookup :: IsInfo a => Key a -> Info -> Maybe a
 lookup k i = case HashMap.lookup (typeRep k) (i ^. infoMap) of
-  Just a -> fromDyn a impossible
+  Just a -> Just $ fromDyn a impossible
   Nothing -> Nothing
 
 lookupDefault :: IsInfo a => a -> Info -> a
diff --git a/src/Juvix/Compiler/Core/Pretty.hs b/src/Juvix/Compiler/Core/Pretty.hs
index 104413b857..9a72bda49d 100644
--- a/src/Juvix/Compiler/Core/Pretty.hs
+++ b/src/Juvix/Compiler/Core/Pretty.hs
@@ -1,5 +1,6 @@
 module Juvix.Compiler.Core.Pretty
   ( module Juvix.Compiler.Core.Pretty,
+    module Juvix.Compiler.Core.Pretty.Base,
     module Juvix.Compiler.Core.Pretty.Options,
   )
 where
diff --git a/src/Juvix/Compiler/Core/Pretty/Base.hs b/src/Juvix/Compiler/Core/Pretty/Base.hs
index 18ed33f413..500de8a146 100644
--- a/src/Juvix/Compiler/Core/Pretty/Base.hs
+++ b/src/Juvix/Compiler/Core/Pretty/Base.hs
@@ -58,20 +58,24 @@ instance PrettyCode BuiltinDataTag where
 instance PrettyCode Tag where
   ppCode = \case
     BuiltinTag tag -> ppCode tag
-    UserTag tag -> return $ kwUnnamedConstr <+> pretty tag
+    UserTag tag -> return $ kwUnnamedConstr <> pretty tag
 
 instance PrettyCode Node where
   ppCode node = case node of
     Var {..} ->
       case Info.lookup kNameInfo varInfo of
         Just ni -> ppCode (ni ^. NameInfo.infoName)
-        Nothing -> return $ kwDeBruijnVar <+> pretty varIndex
+        Nothing -> return $ kwDeBruijnVar <> pretty varIndex
     Ident {..} ->
       case Info.lookup kNameInfo identInfo of
         Just ni -> ppCode (ni ^. NameInfo.infoName)
-        Nothing -> return $ kwUnnamedIdent <+> pretty identSymbol
-    Constant _ (ConstInteger int) -> return $ pretty int
-    Constant _ (ConstBool b) -> return $ pretty b
+        Nothing -> return $ kwUnnamedIdent <> pretty identSymbol
+    Constant _ (ConstInteger int) ->
+      return $ annotate AnnLiteralInteger (pretty int)
+    Constant _ (ConstBool True) ->
+      return $ annotate (AnnKind KNameConstructor) (pretty ("true" :: String))
+    Constant _ (ConstBool False) ->
+      return $ annotate (AnnKind KNameConstructor) (pretty ("false" :: String))
     Axiom {..} ->
       case Info.lookup kNameInfo axiomInfo of
         Just ni -> ppCode (ni ^. NameInfo.infoName)
@@ -95,15 +99,15 @@ instance PrettyCode Node where
       let (infos, body) = unfoldLambdas' node
       pplams <- mapM ppLam infos
       b <- ppCode body
-      return $ foldr (<+>) (braces b) pplams
+      return $ foldl (flip (<+>)) (braces b) pplams
       where
         ppLam :: Member (Reader Options) r => Info -> Sem r (Doc Ann)
         ppLam i =
           case Info.lookup kBinderInfo i of
             Just bi -> do
               n <- ppCode (bi ^. BinderInfo.infoName)
-              return $ kwLambda <+> n
-            Nothing -> return $ kwLambda <+> kwQuestion
+              return $ kwLambda <> n
+            Nothing -> return $ kwLambda <> kwQuestion
     Let {..} -> do
       n' <-
         case Info.lookup kBinderInfo letInfo of
diff --git a/src/Juvix/Compiler/Core/Translation/FromSource.hs b/src/Juvix/Compiler/Core/Translation/FromSource.hs
index ca85a64cc7..69fcc18107 100644
--- a/src/Juvix/Compiler/Core/Translation/FromSource.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromSource.hs
@@ -67,7 +67,9 @@ parseToplevel ::
 parseToplevel = do
   space
   P.sepEndBy statement kwSemicolon
-  optional expression
+  r <- optional expression
+  P.eof
+  return r
 
 statement ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
diff --git a/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs b/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs
index 49875555da..c45860acb1 100644
--- a/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs
@@ -38,7 +38,10 @@ boolean :: Member (Reader ParserParams) r => ParsecS r (Bool, Interval)
 boolean = interval (kwTrue >> return True) <|> interval (kwFalse >> return False)
 
 keyword :: Text -> ParsecS r ()
-keyword = void . keyword' space
+keyword = keyword' space
+
+rawKeyword :: Text -> ParsecS r ()
+rawKeyword = rawKeyword' space
 
 identifier :: ParsecS r Text
 identifier = lexeme bareIdentifier
@@ -109,7 +112,7 @@ kwInductive :: ParsecS r ()
 kwInductive = keyword Str.inductive
 
 kwLambda :: ParsecS r ()
-kwLambda = keyword Str.lambdaUnicode <|> keyword Str.lambdaAscii
+kwLambda = rawKeyword Str.lambdaUnicode <|> rawKeyword Str.lambdaAscii
 
 kwLet :: ParsecS r ()
 kwLet = keyword Str.let_
diff --git a/src/Juvix/Parser/Lexer.hs b/src/Juvix/Parser/Lexer.hs
index bbd8292173..5591575af1 100644
--- a/src/Juvix/Parser/Lexer.hs
+++ b/src/Juvix/Parser/Lexer.hs
@@ -77,6 +77,12 @@ keywordL' spc kw = do
     spc
     return i
 
+rawKeyword' :: ParsecS r () -> Text -> ParsecS r ()
+rawKeyword' spc kw = do
+  P.try $ do
+    void (P.chunk kw)
+    spc
+
 rawIdentifier :: [ParsecS r ()] -> ParsecS r Text
 rawIdentifier allKeywords = do
   notFollowedBy (choice allKeywords)

From f5c1c2ebed8df38fbc04eaf497645d7d7e94154a Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Thu, 11 Aug 2022 16:54:09 +0200
Subject: [PATCH 42/85] transformations

---
 src/Juvix/Compiler/Core/Data/InfoTable.hs     |  2 +
 src/Juvix/Compiler/Core/Extra.hs              | 22 +-------
 src/Juvix/Compiler/Core/Extra/Base.hs         |  2 +-
 src/Juvix/Compiler/Core/Language.hs           | 16 +++---
 src/Juvix/Compiler/Core/Transformation.hs     |  9 +++
 .../Compiler/Core/Transformation/Base.hs      | 22 ++++++++
 src/Juvix/Compiler/Core/Transformation/Eta.hs | 55 +++++++++++++++++++
 .../Core/Transformation/LambdaLifting.hs      | 16 ++++++
 .../Compiler/Core/Translation/FromSource.hs   |  6 +-
 9 files changed, 120 insertions(+), 30 deletions(-)
 create mode 100644 src/Juvix/Compiler/Core/Transformation.hs
 create mode 100644 src/Juvix/Compiler/Core/Transformation/Base.hs
 create mode 100644 src/Juvix/Compiler/Core/Transformation/Eta.hs
 create mode 100644 src/Juvix/Compiler/Core/Transformation/LambdaLifting.hs

diff --git a/src/Juvix/Compiler/Core/Data/InfoTable.hs b/src/Juvix/Compiler/Core/Data/InfoTable.hs
index ad0ad8efe5..4e5e91f15a 100644
--- a/src/Juvix/Compiler/Core/Data/InfoTable.hs
+++ b/src/Juvix/Compiler/Core/Data/InfoTable.hs
@@ -9,6 +9,7 @@ data InfoTable = InfoTable
   { _identContext :: IdentContext,
     -- `_identMap` is needed only for REPL
     _identMap :: HashMap Text (Either Symbol Tag),
+    _infoMain :: Maybe Symbol,
     _infoIdents :: HashMap Symbol IdentInfo,
     _infoInductives :: HashMap Name InductiveInfo,
     _infoConstructors :: HashMap Tag ConstructorInfo,
@@ -20,6 +21,7 @@ emptyInfoTable =
   InfoTable
     { _identContext = mempty,
       _identMap = mempty,
+      _infoMain = Nothing,
       _infoIdents = mempty,
       _infoInductives = mempty,
       _infoConstructors = mempty,
diff --git a/src/Juvix/Compiler/Core/Extra.hs b/src/Juvix/Compiler/Core/Extra.hs
index ebd6a8a931..dae36a3b85 100644
--- a/src/Juvix/Compiler/Core/Extra.hs
+++ b/src/Juvix/Compiler/Core/Extra.hs
@@ -77,7 +77,7 @@ substEnv :: Env -> Node -> Node
 substEnv env = umapN go
   where
     go k n = case n of
-      Var _ idx | idx >= k -> env !! k
+      Var _ idx | idx >= k -> env !! (idx - k)
       _ -> n
 
 convertClosures :: Node -> Node
@@ -106,23 +106,3 @@ convertSuspended = umap go
 
 convertRuntimeNodes :: Node -> Node
 convertRuntimeNodes = convertSuspended . convertData . convertClosures
-
-etaExpandBuiltins :: Node -> Node
-etaExpandBuiltins = umap go
-  where
-    go :: Node -> Node
-    go n = case n of
-      BuiltinApp {..}
-        | builtinOpArgsNum builtinOp > length builtinArgs ->
-            etaExpand (builtinOpArgsNum builtinOp - length builtinArgs) n
-      _ -> n
-
-etaExpandConstrs :: (Tag -> Int) -> Node -> Node
-etaExpandConstrs argsNum = umap go
-  where
-    go :: Node -> Node
-    go n = case n of
-      ConstrApp {..}
-        | argsNum constrTag > length constrArgs ->
-            etaExpand (argsNum constrTag - length constrArgs) n
-      _ -> n
diff --git a/src/Juvix/Compiler/Core/Extra/Base.hs b/src/Juvix/Compiler/Core/Extra/Base.hs
index bcce518c77..5aefc73c92 100644
--- a/src/Juvix/Compiler/Core/Extra/Base.hs
+++ b/src/Juvix/Compiler/Core/Extra/Base.hs
@@ -60,7 +60,7 @@ unfoldLambdas :: Node -> (Int, Node)
 unfoldLambdas = first length . unfoldLambdas'
 
 etaExpand :: Int -> Node -> Node
-etaExpand k n = mkLambdas k (mkApp n (map (Var Info.empty) [0 .. k - 1]))
+etaExpand k n = mkLambdas k (mkApp n (map (Var Info.empty) (reverse [0 .. k - 1])))
 
 -- `NodeDetails` is a convenience datatype which provides the most commonly needed
 -- information about a node in a generic fashion.
diff --git a/src/Juvix/Compiler/Core/Language.hs b/src/Juvix/Compiler/Core/Language.hs
index 2bfd71db0c..337ca86ec1 100644
--- a/src/Juvix/Compiler/Core/Language.hs
+++ b/src/Juvix/Compiler/Core/Language.hs
@@ -38,7 +38,7 @@ data Node
     -- must be equal to the number of arguments expected by the builtin
     -- operation (this simplifies evaluation and code generation). If you need
     -- partial application, eta-expand with lambdas, e.g., eta-expand `(+) 2` to
-    -- `\x -> (+) 2 x`. See `etaExpand` in Extra/Base.hs and `etaExpand*` in Extra.hs.
+    -- `\x -> (+) 2 x`. See Transformation/Eta.hs.
     BuiltinApp {builtinInfo :: !Info, builtinOp :: !BuiltinOp, builtinArgs :: ![Node]}
   | -- A data constructor application. The number of arguments supplied must be
     -- equal to the number of arguments expected by the constructor.
@@ -129,11 +129,13 @@ instance HasAtomicity Node where
     BuiltinApp {} -> Aggregate appFixity
     ConstrApp {..} | null constrArgs -> Atom
     ConstrApp {} -> Aggregate appFixity
-    -- TODO: the fixities need to be fixed
-    Lambda {} -> Aggregate appFixity
-    Let {} -> Aggregate appFixity
-    Case {} -> Aggregate appFixity
-    If {} -> Aggregate appFixity
+    Lambda {} -> Aggregate lambdaFixity
+    Let {} -> Aggregate lambdaFixity
+    Case {} -> Aggregate lambdaFixity
+    If {} -> Aggregate lambdaFixity
     Data {} -> Aggregate appFixity
-    Closure {} -> Aggregate appFixity
+    Closure {} -> Aggregate lambdaFixity
     Suspended {} -> Aggregate appFixity
+
+lambdaFixity :: Fixity
+lambdaFixity = Fixity (PrecNat 0) (Unary AssocPostfix)
diff --git a/src/Juvix/Compiler/Core/Transformation.hs b/src/Juvix/Compiler/Core/Transformation.hs
new file mode 100644
index 0000000000..58fd5d3376
--- /dev/null
+++ b/src/Juvix/Compiler/Core/Transformation.hs
@@ -0,0 +1,9 @@
+module Juvix.Compiler.Core.Transformation(
+  module Juvix.Compiler.Core.Transformation.Base,
+  module Juvix.Compiler.Core.Transformation.Eta,
+  module Juvix.Compiler.Core.Transformation.LambdaLifting,
+) where
+
+import Juvix.Compiler.Core.Transformation.Base
+import Juvix.Compiler.Core.Transformation.Eta
+import Juvix.Compiler.Core.Transformation.LambdaLifting
diff --git a/src/Juvix/Compiler/Core/Transformation/Base.hs b/src/Juvix/Compiler/Core/Transformation/Base.hs
new file mode 100644
index 0000000000..65172aa968
--- /dev/null
+++ b/src/Juvix/Compiler/Core/Transformation/Base.hs
@@ -0,0 +1,22 @@
+module Juvix.Compiler.Core.Transformation.Base
+  ( module Juvix.Compiler.Core.Transformation.Base,
+    module Juvix.Compiler.Core.Data.InfoTable,
+    module Juvix.Compiler.Core.Language,
+  )
+where
+
+import Data.HashMap.Strict qualified as HashMap
+import Juvix.Compiler.Core.Data.InfoTable
+import Juvix.Compiler.Core.Data.InfoTableBuilder
+import Juvix.Compiler.Core.Language
+
+type Transformation = InfoTable -> InfoTable
+
+mapT :: (Node -> Node) -> InfoTable -> InfoTable
+mapT f tab = tab {_identContext = HashMap.map f (tab ^. identContext)}
+
+mapT' :: (Node -> Sem (InfoTableBuilder ': r) Node) -> InfoTable -> Sem r InfoTable
+mapT' f tab = fmap fst $ runInfoTableBuilder tab $ do
+  mapM_
+    (\(k, v) -> f v >>= registerIdentNode k)
+    (HashMap.toList (tab ^. identContext))
diff --git a/src/Juvix/Compiler/Core/Transformation/Eta.hs b/src/Juvix/Compiler/Core/Transformation/Eta.hs
new file mode 100644
index 0000000000..23b25461d6
--- /dev/null
+++ b/src/Juvix/Compiler/Core/Transformation/Eta.hs
@@ -0,0 +1,55 @@
+module Juvix.Compiler.Core.Transformation.Eta
+  ( module Juvix.Compiler.Core.Transformation.Eta,
+    module Juvix.Compiler.Core.Transformation.Base,
+  )
+where
+
+import Data.HashMap.Strict qualified as HashMap
+import Juvix.Compiler.Core.Extra
+import Juvix.Compiler.Core.Transformation.Base
+
+etaExpandBuiltins :: Node -> Node
+etaExpandBuiltins = umap go
+  where
+    go :: Node -> Node
+    go n = case n of
+      BuiltinApp {..}
+        | builtinOpArgsNum builtinOp > length builtinArgs ->
+            etaExpand (builtinOpArgsNum builtinOp - length builtinArgs) n
+      _ -> n
+
+etaExpandConstrs :: (Tag -> Int) -> Node -> Node
+etaExpandConstrs argsNum = umap go
+  where
+    go :: Node -> Node
+    go n = case n of
+      ConstrApp {..}
+        | k > length constrArgs ->
+            etaExpand (k - length constrArgs) n
+        where
+          k = argsNum constrTag
+      _ -> n
+
+squashApps :: Node -> Node
+squashApps = dmap go
+  where
+    go :: Node -> Node
+    go n =
+      let (l, args) = unfoldApp n
+       in case l of
+            ConstrApp i tag args' -> ConstrApp i tag (args' ++ args)
+            BuiltinApp i op args' -> BuiltinApp i op (args' ++ args)
+            _ -> n
+
+etaExpandApps :: InfoTable -> Node -> Node
+etaExpandApps tab =
+  squashApps . etaExpandConstrs constrArgsNum . etaExpandBuiltins . squashApps
+  where
+    constrArgsNum :: Tag -> Int
+    constrArgsNum tag =
+      case HashMap.lookup tag (tab ^. infoConstructors) of
+        Just ci -> ci ^. constructorArgsNum
+        Nothing -> 0
+
+etaExpansionApps :: Transformation
+etaExpansionApps tab = mapT (etaExpandApps tab) tab
diff --git a/src/Juvix/Compiler/Core/Transformation/LambdaLifting.hs b/src/Juvix/Compiler/Core/Transformation/LambdaLifting.hs
new file mode 100644
index 0000000000..f814a22242
--- /dev/null
+++ b/src/Juvix/Compiler/Core/Transformation/LambdaLifting.hs
@@ -0,0 +1,16 @@
+module Juvix.Compiler.Core.Transformation.LambdaLifting
+  ( module Juvix.Compiler.Core.Transformation.LambdaLifting,
+    module Juvix.Compiler.Core.Transformation.Base,
+  )
+where
+
+import Juvix.Compiler.Core.Transformation.Base
+import Juvix.Compiler.Core.Data.InfoTableBuilder
+
+lambdaLiftNode :: Member InfoTableBuilder r => Node -> Sem r Node
+lambdaLiftNode _ = do
+  void freshSymbol
+  error "not yet implemented"
+
+lambdaLifting :: Transformation
+lambdaLifting = run . mapT' lambdaLiftNode
diff --git a/src/Juvix/Compiler/Core/Translation/FromSource.hs b/src/Juvix/Compiler/Core/Translation/FromSource.hs
index 69fcc18107..ae8c1e78fd 100644
--- a/src/Juvix/Compiler/Core/Translation/FromSource.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromSource.hs
@@ -13,6 +13,7 @@ import Juvix.Compiler.Core.Language.Info.BranchInfo as BranchInfo
 import Juvix.Compiler.Core.Language.Info.LocationInfo as LocationInfo
 import Juvix.Compiler.Core.Language.Info.NameInfo as NameInfo
 import Juvix.Compiler.Core.Language.Type
+import Juvix.Compiler.Core.Transformation.Eta
 import Juvix.Compiler.Core.Translation.FromSource.Lexer
 import Juvix.Parser.Error
 import Text.Megaparsec qualified as P
@@ -153,7 +154,10 @@ statementConstr = do
 expression ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
   ParsecS r Node
-expression = expr 0 mempty
+expression = do
+  node <- expr 0 mempty
+  tab <- lift getInfoTable
+  return $ etaExpandApps tab node
 
 expr ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>

From 0afabbb179310c4b3344bcf99e0d994cf355a82a Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Thu, 11 Aug 2022 17:20:23 +0200
Subject: [PATCH 43/85] refactor for PR #1443

---
 .../Analysis/Scoping/Error/Types.hs           |  1 +
 src/Juvix/Compiler/Core/Error.hs              |  1 -
 src/Juvix/Compiler/Core/Pretty.hs             | 17 ++-----
 src/Juvix/Compiler/Core/Pretty/Ann.hs         | 12 -----
 src/Juvix/Compiler/Core/Pretty/Ansi.hs        | 12 -----
 src/Juvix/Compiler/Core/Pretty/Base.hs        | 47 +++----------------
 src/Juvix/Compiler/Core/Transformation.hs     | 11 +++--
 .../Core/Transformation/LambdaLifting.hs      |  2 +-
 8 files changed, 17 insertions(+), 86 deletions(-)
 delete mode 100644 src/Juvix/Compiler/Core/Pretty/Ann.hs
 delete mode 100644 src/Juvix/Compiler/Core/Pretty/Ansi.hs

diff --git a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Types.hs b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Types.hs
index 8560c79559..522f217c09 100644
--- a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Types.hs
+++ b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Types.hs
@@ -14,6 +14,7 @@ import Juvix.Compiler.Concrete.Language
 import Juvix.Compiler.Concrete.Language qualified as L
 import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping.Error.Pretty
 import Juvix.Data.CodeAnn
+import Juvix.Parser.Error qualified as Parser
 import Juvix.Prelude
 
 data MultipleDeclarations = MultipleDeclarations
diff --git a/src/Juvix/Compiler/Core/Error.hs b/src/Juvix/Compiler/Core/Error.hs
index eafaf28118..7ddc72b41c 100644
--- a/src/Juvix/Compiler/Core/Error.hs
+++ b/src/Juvix/Compiler/Core/Error.hs
@@ -2,7 +2,6 @@ module Juvix.Compiler.Core.Error where
 
 import Juvix.Compiler.Core.Language
 import Juvix.Compiler.Core.Pretty
-import Juvix.Prelude.Pretty
 
 data CoreError = CoreError
   { _coreErrorMsg :: Text,
diff --git a/src/Juvix/Compiler/Core/Pretty.hs b/src/Juvix/Compiler/Core/Pretty.hs
index 9a72bda49d..00ae60469e 100644
--- a/src/Juvix/Compiler/Core/Pretty.hs
+++ b/src/Juvix/Compiler/Core/Pretty.hs
@@ -2,19 +2,16 @@ module Juvix.Compiler.Core.Pretty
   ( module Juvix.Compiler.Core.Pretty,
     module Juvix.Compiler.Core.Pretty.Base,
     module Juvix.Compiler.Core.Pretty.Options,
+    module Juvix.Data.PPOutput,
   )
 where
 
-import Juvix.Compiler.Core.Pretty.Ann
-import Juvix.Compiler.Core.Pretty.Ansi qualified as Ansi
 import Juvix.Compiler.Core.Pretty.Base
 import Juvix.Compiler.Core.Pretty.Options
+import Juvix.Data.PPOutput
 import Juvix.Prelude
-import Juvix.Prelude.Pretty
 import Prettyprinter.Render.Terminal qualified as Ansi
 
-newtype PPOutput = PPOutput (Doc Ann)
-
 ppOutDefault :: PrettyCode c => c -> AnsiText
 ppOutDefault = AnsiText . PPOutput . doc defaultOptions
 
@@ -22,12 +19,4 @@ ppOut :: PrettyCode c => Options -> c -> AnsiText
 ppOut o = AnsiText . PPOutput . doc o
 
 ppTrace :: PrettyCode c => c -> Text
-ppTrace = Ansi.renderStrict . reAnnotateS Ansi.stylize . layoutPretty defaultLayoutOptions . doc defaultOptions
-
-instance HasAnsiBackend PPOutput where
-  toAnsiStream (PPOutput o) = reAnnotateS Ansi.stylize (layoutPretty defaultLayoutOptions o)
-  toAnsiDoc (PPOutput o) = reAnnotate Ansi.stylize o
-
-instance HasTextBackend PPOutput where
-  toTextDoc (PPOutput o) = unAnnotate o
-  toTextStream (PPOutput o) = unAnnotateS (layoutPretty defaultLayoutOptions o)
+ppTrace = Ansi.renderStrict . reAnnotateS stylize . layoutPretty defaultLayoutOptions . doc defaultOptions
diff --git a/src/Juvix/Compiler/Core/Pretty/Ann.hs b/src/Juvix/Compiler/Core/Pretty/Ann.hs
deleted file mode 100644
index e520050145..0000000000
--- a/src/Juvix/Compiler/Core/Pretty/Ann.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-module Juvix.Compiler.Core.Pretty.Ann where
-
-import Juvix.Compiler.Concrete.Data.NameKind
-
-data Ann
-  = AnnKind NameKind
-  | AnnKeyword
-  | AnnLiteralString
-  | AnnLiteralInteger
-
-instance HasNameKindAnn Ann where
-  annNameKind = AnnKind
diff --git a/src/Juvix/Compiler/Core/Pretty/Ansi.hs b/src/Juvix/Compiler/Core/Pretty/Ansi.hs
deleted file mode 100644
index 739dc15cd8..0000000000
--- a/src/Juvix/Compiler/Core/Pretty/Ansi.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-module Juvix.Compiler.Core.Pretty.Ansi where
-
-import Juvix.Compiler.Core.Language
-import Juvix.Compiler.Core.Pretty.Base
-import Prettyprinter.Render.Terminal
-
-stylize :: Ann -> AnsiStyle
-stylize a = case a of
-  AnnKind k -> nameKindAnsi k
-  AnnKeyword -> colorDull Blue
-  AnnLiteralString -> colorDull Red
-  AnnLiteralInteger -> colorDull Cyan
diff --git a/src/Juvix/Compiler/Core/Pretty/Base.hs b/src/Juvix/Compiler/Core/Pretty/Base.hs
index 500de8a146..aafb244ec4 100644
--- a/src/Juvix/Compiler/Core/Pretty/Base.hs
+++ b/src/Juvix/Compiler/Core/Pretty/Base.hs
@@ -1,6 +1,6 @@
 module Juvix.Compiler.Core.Pretty.Base
   ( module Juvix.Compiler.Core.Pretty.Base,
-    module Juvix.Compiler.Core.Pretty.Ann,
+    module Juvix.Data.CodeAnn,
     module Juvix.Compiler.Core.Pretty.Options,
   )
 where
@@ -11,10 +11,9 @@ import Juvix.Compiler.Core.Language.Info qualified as Info
 import Juvix.Compiler.Core.Language.Info.BinderInfo as BinderInfo
 import Juvix.Compiler.Core.Language.Info.BranchInfo as BranchInfo
 import Juvix.Compiler.Core.Language.Info.NameInfo as NameInfo
-import Juvix.Compiler.Core.Pretty.Ann
 import Juvix.Compiler.Core.Pretty.Options
+import Juvix.Data.CodeAnn
 import Juvix.Extra.Strings qualified as Str
-import Juvix.Prelude.Pretty
 
 doc :: PrettyCode c => Options -> c -> Doc Ann
 doc opts =
@@ -134,7 +133,7 @@ instance PrettyCode Node where
             d' <- ppCode def
             return $ bs' ++ [kwDefault <+> kwArrow <+> d']
           Nothing -> return bs'
-      bss <- bracesIndent $ align $ concatWith (\a b -> a <> line <> b <> kwSemicolon) bs''
+      let bss = bracesIndent $ align $ concatWith (\a b -> a <> line <> b <> kwSemicolon) bs''
       return $ kwCase <+> v <+> kwOf <> bss
     If {..} -> do
       v <- ppCode ifValue
@@ -147,7 +146,7 @@ instance PrettyCode Node where
         case Info.lookup kNameInfo dataInfo of
           Just ni -> ppCode (ni ^. NameInfo.infoName)
           Nothing -> ppCode dataTag
-      return $ kwData <+> foldl (<+>) n' args'
+      return $ kwConstrData <+> foldl (<+>) n' args'
     Closure {} -> return kwClosure
     Suspended {..} -> (<+>) kwSuspended <$> ppCode suspendedNode
 
@@ -159,16 +158,6 @@ instance PrettyCode a => PrettyCode (NonEmpty a) where
 {--------------------------------------------------------------------------------}
 {- helper functions -}
 
-indent' :: Member (Reader Options) r => Doc a -> Sem r (Doc a)
-indent' d = do
-  i <- asks (^. optIndent)
-  return $ indent i d
-
-bracesIndent :: Members '[Reader Options] r => Doc Ann -> Sem r (Doc Ann)
-bracesIndent d = do
-  d' <- indent' d
-  return $ braces (line <> d' <> line)
-
 parensIf :: Bool -> Doc Ann -> Doc Ann
 parensIf t = if t then parens else id
 
@@ -206,9 +195,6 @@ ppLRExpression associates fixlr e =
 {--------------------------------------------------------------------------------}
 {- keywords -}
 
-keyword :: Text -> Doc Ann
-keyword = annotate AnnKeyword . pretty
-
 kwDeBruijnVar :: Doc Ann
 kwDeBruijnVar = keyword Str.deBruijnVar
 
@@ -221,30 +207,12 @@ kwUnnamedConstr = keyword Str.exclamation
 kwQuestion :: Doc Ann
 kwQuestion = keyword Str.questionMark
 
-kwLambda :: Doc Ann
-kwLambda = keyword Str.lambdaUnicode
-
-kwArrow :: Doc Ann
-kwArrow = keyword Str.toUnicode
-
-kwAssign :: Doc Ann
-kwAssign = keyword Str.assignUnicode
-
-kwEquals :: Doc Ann
-kwEquals = keyword Str.equal
-
 kwLess :: Doc Ann
 kwLess = keyword Str.less
 
 kwLessEquals :: Doc Ann
 kwLessEquals = keyword Str.lessEqual
 
-kwLet :: Doc Ann
-kwLet = keyword Str.let_
-
-kwIn :: Doc Ann
-kwIn = keyword Str.in_
-
 kwPlus :: Doc Ann
 kwPlus = keyword Str.plus
 
@@ -284,9 +252,6 @@ kwOf = keyword Str.of_
 kwDefault :: Doc Ann
 kwDefault = keyword Str.underscore
 
-kwSemicolon :: Doc Ann
-kwSemicolon = keyword Str.semicolon
-
 kwIf :: Doc Ann
 kwIf = keyword Str.if_
 
@@ -296,8 +261,8 @@ kwThen = keyword Str.then_
 kwElse :: Doc Ann
 kwElse = keyword Str.else_
 
-kwData :: Doc Ann
-kwData = keyword Str.constrData
+kwConstrData :: Doc Ann
+kwConstrData = keyword Str.constrData
 
 kwClosure :: Doc Ann
 kwClosure = keyword Str.closure
diff --git a/src/Juvix/Compiler/Core/Transformation.hs b/src/Juvix/Compiler/Core/Transformation.hs
index 58fd5d3376..0da169b0b2 100644
--- a/src/Juvix/Compiler/Core/Transformation.hs
+++ b/src/Juvix/Compiler/Core/Transformation.hs
@@ -1,8 +1,9 @@
-module Juvix.Compiler.Core.Transformation(
-  module Juvix.Compiler.Core.Transformation.Base,
-  module Juvix.Compiler.Core.Transformation.Eta,
-  module Juvix.Compiler.Core.Transformation.LambdaLifting,
-) where
+module Juvix.Compiler.Core.Transformation
+  ( module Juvix.Compiler.Core.Transformation.Base,
+    module Juvix.Compiler.Core.Transformation.Eta,
+    module Juvix.Compiler.Core.Transformation.LambdaLifting,
+  )
+where
 
 import Juvix.Compiler.Core.Transformation.Base
 import Juvix.Compiler.Core.Transformation.Eta
diff --git a/src/Juvix/Compiler/Core/Transformation/LambdaLifting.hs b/src/Juvix/Compiler/Core/Transformation/LambdaLifting.hs
index f814a22242..21592a1a5a 100644
--- a/src/Juvix/Compiler/Core/Transformation/LambdaLifting.hs
+++ b/src/Juvix/Compiler/Core/Transformation/LambdaLifting.hs
@@ -4,8 +4,8 @@ module Juvix.Compiler.Core.Transformation.LambdaLifting
   )
 where
 
-import Juvix.Compiler.Core.Transformation.Base
 import Juvix.Compiler.Core.Data.InfoTableBuilder
+import Juvix.Compiler.Core.Transformation.Base
 
 lambdaLiftNode :: Member InfoTableBuilder r => Node -> Sem r Node
 lambdaLiftNode _ = do

From 5098e6e5035896f8d6d4e201f41038e0f28e01e5 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Thu, 11 Aug 2022 17:40:13 +0200
Subject: [PATCH 44/85] JuvixCore parsing bugfixes

---
 .../Compiler/Core/Translation/FromSource.hs     | 17 ++++++++++++-----
 1 file changed, 12 insertions(+), 5 deletions(-)

diff --git a/src/Juvix/Compiler/Core/Translation/FromSource.hs b/src/Juvix/Compiler/Core/Translation/FromSource.hs
index ae8c1e78fd..d2c68fb2fb 100644
--- a/src/Juvix/Compiler/Core/Translation/FromSource.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromSource.hs
@@ -67,7 +67,7 @@ parseToplevel ::
   ParsecS r (Maybe Node)
 parseToplevel = do
   space
-  P.sepEndBy statement kwSemicolon
+  P.endBy statement kwSemicolon
   r <- optional expression
   P.eof
   return r
@@ -345,7 +345,7 @@ builtinAppExpr varsNum vars = do
       <|> (kwMinus >> return OpIntSub)
       <|> (kwDiv >> return OpIntDiv)
       <|> (kwMul >> return OpIntMul)
-  args <- P.some (atom varsNum vars)
+  args <- P.many (atom varsNum vars)
   return $ BuiltinApp Info.empty op args
 
 atoms ::
@@ -411,11 +411,18 @@ exprConstBool = P.try $ do
   return $ Constant (Info.singleton (LocationInfo i)) (ConstBool b)
 
 parseLocalName ::
+  forall r.
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
   ParsecS r Name
-parseLocalName = do
-  (txt, i) <- identifierL
-  freshName KNameLocal txt i
+parseLocalName =
+  parseWildcardName <|> do
+    (txt, i) <- identifierL
+    freshName KNameLocal txt i
+  where
+    parseWildcardName :: ParsecS r Name
+    parseWildcardName = do
+      ((), i) <- interval kwWildcard
+      freshName KNameLocal "_" i
 
 exprLambda ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>

From 0cb52d7731e66e447e006cc6b2669a41fc37d56d Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Mon, 15 Aug 2022 09:01:13 +0200
Subject: [PATCH 45/85] JuvixCore pretty printing minor changes

---
 src/Juvix/Compiler/Core/Language.hs    | 8 ++++----
 src/Juvix/Compiler/Core/Pretty/Base.hs | 2 +-
 2 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/src/Juvix/Compiler/Core/Language.hs b/src/Juvix/Compiler/Core/Language.hs
index 337ca86ec1..a774538dde 100644
--- a/src/Juvix/Compiler/Core/Language.hs
+++ b/src/Juvix/Compiler/Core/Language.hs
@@ -126,16 +126,16 @@ instance HasAtomicity Node where
     Axiom {} -> Atom
     App {} -> Aggregate appFixity
     BuiltinApp {..} | null builtinArgs -> Atom
-    BuiltinApp {} -> Aggregate appFixity
+    BuiltinApp {} -> Aggregate lambdaFixity
     ConstrApp {..} | null constrArgs -> Atom
-    ConstrApp {} -> Aggregate appFixity
+    ConstrApp {} -> Aggregate lambdaFixity
     Lambda {} -> Aggregate lambdaFixity
     Let {} -> Aggregate lambdaFixity
     Case {} -> Aggregate lambdaFixity
     If {} -> Aggregate lambdaFixity
-    Data {} -> Aggregate appFixity
+    Data {} -> Aggregate lambdaFixity
     Closure {} -> Aggregate lambdaFixity
-    Suspended {} -> Aggregate appFixity
+    Suspended {} -> Aggregate lambdaFixity
 
 lambdaFixity :: Fixity
 lambdaFixity = Fixity (PrecNat 0) (Unary AssocPostfix)
diff --git a/src/Juvix/Compiler/Core/Pretty/Base.hs b/src/Juvix/Compiler/Core/Pretty/Base.hs
index aafb244ec4..d2ee42e872 100644
--- a/src/Juvix/Compiler/Core/Pretty/Base.hs
+++ b/src/Juvix/Compiler/Core/Pretty/Base.hs
@@ -98,7 +98,7 @@ instance PrettyCode Node where
       let (infos, body) = unfoldLambdas' node
       pplams <- mapM ppLam infos
       b <- ppCode body
-      return $ foldl (flip (<+>)) (braces b) pplams
+      return $ foldl (flip (<+>)) b pplams
       where
         ppLam :: Member (Reader Options) r => Info -> Sem r (Doc Ann)
         ppLam i =

From 4d2603ac17d85a4b3e1781b9d8cd6d7ac5a67a52 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Mon, 15 Aug 2022 09:33:14 +0200
Subject: [PATCH 46/85] String constants

---
 src/Juvix/Compiler/Core/Language.hs                     | 4 ++--
 src/Juvix/Compiler/Core/Pretty/Base.hs                  | 2 ++
 src/Juvix/Compiler/Core/Translation/FromSource.hs       | 8 ++++++++
 src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs | 4 ++--
 4 files changed, 14 insertions(+), 4 deletions(-)

diff --git a/src/Juvix/Compiler/Core/Language.hs b/src/Juvix/Compiler/Core/Language.hs
index a774538dde..3487a730bd 100644
--- a/src/Juvix/Compiler/Core/Language.hs
+++ b/src/Juvix/Compiler/Core/Language.hs
@@ -94,10 +94,10 @@ data Node
 data ConstantValue
   = ConstInteger !Integer
   | ConstBool !Bool
+  | ConstString !Text
 
 -- Other things we might need in the future:
--- - ConstString
--- - ConstFixedPoint
+-- - ConstFloat
 
 -- `CaseBranch tag argsNum branch`
 -- - `argsNum` is the number of arguments of the constructor tagged with `tag`,
diff --git a/src/Juvix/Compiler/Core/Pretty/Base.hs b/src/Juvix/Compiler/Core/Pretty/Base.hs
index d2ee42e872..eef526024f 100644
--- a/src/Juvix/Compiler/Core/Pretty/Base.hs
+++ b/src/Juvix/Compiler/Core/Pretty/Base.hs
@@ -75,6 +75,8 @@ instance PrettyCode Node where
       return $ annotate (AnnKind KNameConstructor) (pretty ("true" :: String))
     Constant _ (ConstBool False) ->
       return $ annotate (AnnKind KNameConstructor) (pretty ("false" :: String))
+    Constant _ (ConstString txt) ->
+      return $ annotate AnnLiteralString (pretty ("\"" ++ fromText txt ++ "\""))
     Axiom {..} ->
       case Info.lookup kNameInfo axiomInfo of
         Just ni -> ppCode (ni ^. NameInfo.infoName)
diff --git a/src/Juvix/Compiler/Core/Translation/FromSource.hs b/src/Juvix/Compiler/Core/Translation/FromSource.hs
index d2c68fb2fb..e3cb40a4ce 100644
--- a/src/Juvix/Compiler/Core/Translation/FromSource.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromSource.hs
@@ -366,6 +366,7 @@ atom varsNum vars =
   exprNamed varsNum vars
     <|> exprConstInt
     <|> exprConstBool
+    <|> exprConstString
     <|> exprLambda varsNum vars
     <|> exprLet varsNum vars
     <|> exprCase varsNum vars
@@ -410,6 +411,13 @@ exprConstBool = P.try $ do
   (b, i) <- boolean
   return $ Constant (Info.singleton (LocationInfo i)) (ConstBool b)
 
+exprConstString ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  ParsecS r Node
+exprConstString = P.try $ do
+  (s, i) <- string
+  return $ Constant (Info.singleton (LocationInfo i)) (ConstString s)
+
 parseLocalName ::
   forall r.
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
diff --git a/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs b/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs
index c45860acb1..95ad140e1f 100644
--- a/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs
@@ -31,8 +31,8 @@ integer = integer' decimal
 number :: Member (Reader ParserParams) r => Int -> Int -> ParsecS r (Int, Interval)
 number = number' integer
 
-string :: ParsecS r Text
-string = string'
+string :: Member (Reader ParserParams) r => ParsecS r (Text, Interval)
+string = lexemeInterval string'
 
 boolean :: Member (Reader ParserParams) r => ParsecS r (Bool, Interval)
 boolean = interval (kwTrue >> return True) <|> interval (kwFalse >> return False)

From 68133a53cc810ac0b56ea785b6e4d225a53ff97c Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Mon, 15 Aug 2022 10:53:05 +0200
Subject: [PATCH 47/85] builtin nil & cons

---
 src/Juvix/Compiler/Core/Language/Builtins.hs  | 10 +----
 src/Juvix/Compiler/Core/Pretty/Base.hs        | 26 +----------
 .../Compiler/Core/Translation/FromSource.hs   | 43 +++++++++++++++----
 3 files changed, 37 insertions(+), 42 deletions(-)

diff --git a/src/Juvix/Compiler/Core/Language/Builtins.hs b/src/Juvix/Compiler/Core/Language/Builtins.hs
index 97d2a99f42..df08cb2d93 100644
--- a/src/Juvix/Compiler/Core/Language/Builtins.hs
+++ b/src/Juvix/Compiler/Core/Language/Builtins.hs
@@ -16,12 +16,8 @@ data BuiltinOp
 
 -- Builtin data tags
 data BuiltinDataTag
-  = TagZero
-  | TagSucc
-  | TagUnit
-  | TagNil
+  = TagNil
   | TagCons
-  | TagPair
   deriving stock (Eq, Generic)
 
 instance Hashable BuiltinDataTag
@@ -38,9 +34,5 @@ builtinOpArgsNum = \case
 
 builtinConstrArgsNum :: BuiltinDataTag -> Int
 builtinConstrArgsNum = \case
-  TagZero -> 0
-  TagSucc -> 1
-  TagUnit -> 0
   TagNil -> 0
   TagCons -> 2
-  TagPair -> 2
diff --git a/src/Juvix/Compiler/Core/Pretty/Base.hs b/src/Juvix/Compiler/Core/Pretty/Base.hs
index eef526024f..fd73ac5d25 100644
--- a/src/Juvix/Compiler/Core/Pretty/Base.hs
+++ b/src/Juvix/Compiler/Core/Pretty/Base.hs
@@ -47,12 +47,8 @@ instance PrettyCode BuiltinOp where
 
 instance PrettyCode BuiltinDataTag where
   ppCode = \case
-    TagZero -> return kwZero
-    TagSucc -> return kwSucc
-    TagUnit -> return kwUnit
-    TagNil -> return kwNil
-    TagCons -> return kwCons
-    TagPair -> return kwPair
+    TagNil -> return $ annotate (AnnKind KNameConstructor) (pretty ("nil" :: String))
+    TagCons -> return $ annotate (AnnKind KNameConstructor) (pretty ("cons" :: String))
 
 instance PrettyCode Tag where
   ppCode = \case
@@ -227,24 +223,6 @@ kwMul = keyword Str.mul
 kwDiv :: Doc Ann
 kwDiv = keyword Str.div
 
-kwZero :: Doc Ann
-kwZero = keyword Str.zero
-
-kwSucc :: Doc Ann
-kwSucc = keyword Str.succ
-
-kwUnit :: Doc Ann
-kwUnit = keyword Str.unit
-
-kwNil :: Doc Ann
-kwNil = keyword Str.nil
-
-kwCons :: Doc Ann
-kwCons = keyword Str.cons
-
-kwPair :: Doc Ann
-kwPair = keyword Str.pair
-
 kwCase :: Doc Ann
 kwCase = keyword Str.case_
 
diff --git a/src/Juvix/Compiler/Core/Translation/FromSource.hs b/src/Juvix/Compiler/Core/Translation/FromSource.hs
index e3cb40a4ce..ec0bba9940 100644
--- a/src/Juvix/Compiler/Core/Translation/FromSource.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromSource.hs
@@ -41,9 +41,9 @@ freshName ::
   NameKind ->
   Text ->
   Interval ->
-  ParsecS r Name
+  Sem r Name
 freshName kind txt i = do
-  nid <- lift freshNameId
+  nid <- freshNameId
   return $
     Name
       { _nameText = txt,
@@ -53,6 +53,23 @@ freshName kind txt i = do
         _nameLoc = i
       }
 
+declareBuiltinConstr ::
+  Members '[InfoTableBuilder, NameIdGen] r =>
+  BuiltinDataTag ->
+  Text ->
+  Interval ->
+  Sem r ()
+declareBuiltinConstr btag nameTxt i = do
+  name <- freshName KNameConstructor nameTxt i
+  registerConstructor
+    ( ConstructorInfo
+        { _constructorName = name,
+          _constructorTag = BuiltinTag btag,
+          _constructorType = Star,
+          _constructorArgsNum = builtinConstrArgsNum btag
+        }
+    )
+
 guardSymbolNotDefined ::
   Member InfoTableBuilder r =>
   Symbol ->
@@ -62,10 +79,18 @@ guardSymbolNotDefined sym err = do
   b <- lift $ checkSymbolDefined sym
   when b err
 
+declareBuiltins :: Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r => ParsecS r ()
+declareBuiltins = do
+  loc <- curLoc
+  let i = mkInterval loc loc
+  lift $ declareBuiltinConstr TagNil "nil" i
+  lift $ declareBuiltinConstr TagCons "cons" i
+
 parseToplevel ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
   ParsecS r (Maybe Node)
 parseToplevel = do
+  declareBuiltins
   space
   P.endBy statement kwSemicolon
   r <- optional expression
@@ -94,7 +119,7 @@ statementDef = do
       parseFailure ("duplicate identifier: " ++ fromText txt)
     Nothing -> do
       sym <- lift freshSymbol
-      name <- freshName KNameFunction txt i
+      name <- lift $ freshName KNameFunction txt i
       let info =
             IdentInfo
               { _identName = name,
@@ -141,7 +166,7 @@ statementConstr = do
     dupl
     (parseFailure ("duplicate identifier: " ++ fromText txt))
   tag <- lift freshTag
-  name <- freshName KNameConstructor txt i
+  name <- lift $ freshName KNameConstructor txt i
   let info =
         ConstructorInfo
           { _constructorName = name,
@@ -383,16 +408,16 @@ exprNamed varsNum vars = do
   (txt, i) <- identifierL
   case HashMap.lookup txt vars of
     Just k -> do
-      name <- freshName KNameLocal txt i
+      name <- lift $ freshName KNameLocal txt i
       return $ Var (Info.singleton (NameInfo name)) (varsNum - k - 1)
     Nothing -> do
       r <- lift (getIdent txt)
       case r of
         Just (Left sym) -> do
-          name <- freshName KNameFunction txt i
+          name <- lift $ freshName KNameFunction txt i
           return $ Ident (Info.singleton (NameInfo name)) sym
         Just (Right tag) -> do
-          name <- freshName KNameConstructor txt i
+          name <- lift $ freshName KNameConstructor txt i
           return $ ConstrApp (Info.singleton (NameInfo name)) tag []
         Nothing ->
           parseFailure ("undeclared identifier: " ++ fromText txt)
@@ -425,12 +450,12 @@ parseLocalName ::
 parseLocalName =
   parseWildcardName <|> do
     (txt, i) <- identifierL
-    freshName KNameLocal txt i
+    lift $ freshName KNameLocal txt i
   where
     parseWildcardName :: ParsecS r Name
     parseWildcardName = do
       ((), i) <- interval kwWildcard
-      freshName KNameLocal "_" i
+      lift $ freshName KNameLocal "_" i
 
 exprLambda ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>

From e7e63ebc0d75932972ad3b7df7ae2db3148aaf2f Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Mon, 15 Aug 2022 11:09:58 +0200
Subject: [PATCH 48/85] JuvixCore parsing improvements

---
 .../Compiler/Core/Translation/FromSource.hs   | 29 +++++++++++--------
 src/Juvix/Parser/Lexer.hs                     |  7 +++--
 2 files changed, 21 insertions(+), 15 deletions(-)

diff --git a/src/Juvix/Compiler/Core/Translation/FromSource.hs b/src/Juvix/Compiler/Core/Translation/FromSource.hs
index ec0bba9940..e458c6b2da 100644
--- a/src/Juvix/Compiler/Core/Translation/FromSource.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromSource.hs
@@ -107,16 +107,17 @@ statementDef ::
   ParsecS r ()
 statementDef = do
   kwDef
+  off <- P.getOffset
   (txt, i) <- identifierL
   r <- lift (getIdent txt)
   case r of
     Just (Left sym) -> do
       guardSymbolNotDefined
         sym
-        (parseFailure ("duplicate definition of: " ++ fromText txt))
+        (parseFailure off ("duplicate definition of: " ++ fromText txt))
       parseDefinition sym
     Just (Right {}) ->
-      parseFailure ("duplicate identifier: " ++ fromText txt)
+      parseFailure off ("duplicate identifier: " ++ fromText txt)
     Nothing -> do
       sym <- lift freshSymbol
       name <- lift $ freshName KNameFunction txt i
@@ -159,12 +160,13 @@ statementConstr ::
   ParsecS r ()
 statementConstr = do
   kwConstr
+  off <- P.getOffset
   (txt, i) <- identifierL
   (argsNum, _) <- number 0 128
   dupl <- lift (hasIdent txt)
   when
     dupl
-    (parseFailure ("duplicate identifier: " ++ fromText txt))
+    (parseFailure off ("duplicate identifier: " ++ fromText txt))
   tag <- lift freshTag
   name <- lift $ freshName KNameConstructor txt i
   let info =
@@ -405,6 +407,7 @@ exprNamed ::
   HashMap Text Index ->
   ParsecS r Node
 exprNamed varsNum vars = do
+  off <- P.getOffset
   (txt, i) <- identifierL
   case HashMap.lookup txt vars of
     Just k -> do
@@ -420,7 +423,7 @@ exprNamed varsNum vars = do
           name <- lift $ freshName KNameConstructor txt i
           return $ ConstrApp (Info.singleton (NameInfo name)) tag []
         Nothing ->
-          parseFailure ("undeclared identifier: " ++ fromText txt)
+          parseFailure off ("undeclared identifier: " ++ fromText txt)
 
 exprConstInt ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
@@ -465,7 +468,6 @@ exprLambda ::
 exprLambda varsNum vars = do
   kwLambda
   name <- parseLocalName
-  optional kwMapsTo
   let vars' = HashMap.insert (name ^. nameText) varsNum vars
   body <- expr (varsNum + 1) vars'
   return $ Lambda (Info.singleton (BinderInfo name Star)) body
@@ -491,19 +493,21 @@ exprCase ::
   HashMap Text Index ->
   ParsecS r Node
 exprCase varsNum vars = do
+  off <- P.getOffset
   kwCase
   value <- expr varsNum vars
   kwOf
-  braces (exprCase' value varsNum vars)
-    <|> exprCase' value varsNum vars
+  braces (exprCase' off value varsNum vars)
+    <|> exprCase' off value varsNum vars
 
 exprCase' ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Int ->
   Node ->
   Index ->
   HashMap Text Index ->
   ParsecS r Node
-exprCase' value varsNum vars = do
+exprCase' off value varsNum vars = do
   bs <- P.sepEndBy (caseBranch varsNum vars) kwSemicolon
   rbrace
   let bs' = map fromLeft' $ filter isLeft bs
@@ -526,7 +530,7 @@ exprCase' value varsNum vars = do
     [] ->
       return $ Case info value bss Nothing
     _ ->
-      parseFailure "multiple default branches"
+      parseFailure off "multiple default branches"
 
 caseBranch ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
@@ -553,18 +557,19 @@ matchingBranch ::
   HashMap Text Index ->
   ParsecS r (CaseBranch, [Name])
 matchingBranch varsNum vars = do
+  off <- P.getOffset
   txt <- identifier
   r <- lift (getIdent txt)
   case r of
     Just (Left {}) ->
-      parseFailure ("not a constructor: " ++ fromText txt)
+      parseFailure off ("not a constructor: " ++ fromText txt)
     Just (Right tag) -> do
       ns <- P.many parseLocalName
       let bindersNum = length ns
       ci <- lift $ getConstructorInfo tag
       when
         (ci ^. constructorArgsNum /= bindersNum)
-        (parseFailure "wrong number of constructor arguments")
+        (parseFailure off "wrong number of constructor arguments")
       kwMapsTo
       let vars' =
             fst $
@@ -577,7 +582,7 @@ matchingBranch varsNum vars = do
       br <- expr (varsNum + bindersNum) vars'
       return (CaseBranch tag bindersNum br, ns)
     Nothing ->
-      parseFailure ("undeclared identifier: " ++ fromText txt)
+      parseFailure off ("undeclared identifier: " ++ fromText txt)
 
 exprIf ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
diff --git a/src/Juvix/Parser/Lexer.hs b/src/Juvix/Parser/Lexer.hs
index 5591575af1..168ea3ebf1 100644
--- a/src/Juvix/Parser/Lexer.hs
+++ b/src/Juvix/Parser/Lexer.hs
@@ -25,8 +25,8 @@ newtype ParserParams = ParserParams
 
 makeLenses ''ParserParams
 
-parseFailure :: String -> ParsecS r a
-parseFailure str = P.fancyFailure $ Set.singleton (P.ErrorFail str)
+parseFailure :: Int -> String -> ParsecS r a
+parseFailure off str = P.parseError $ P.FancyError off (Set.singleton (P.ErrorFail str))
 
 space' :: forall r. Bool -> (forall a. ParsecS r a -> ParsecS r ()) -> ParsecS r ()
 space' judoc comment_ = L.space space1 lineComment block
@@ -53,10 +53,11 @@ integer' dec = do
 
 number' :: ParsecS r (Integer, Interval) -> Int -> Int -> ParsecS r (Int, Interval)
 number' int mn mx = do
+  off <- getOffset
   (n, i) <- int
   when
     (n < fromIntegral mn || n > fromIntegral mx)
-    (parseFailure ("number out of bounds: " ++ show n))
+    (parseFailure off ("number out of bounds: " ++ show n))
   return (fromInteger n, i)
 
 string' :: ParsecS r Text

From ee68874fd672c375474494f359c2b5c08aa215a4 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Mon, 15 Aug 2022 13:41:52 +0200
Subject: [PATCH 49/85] IO monad builtins

---
 app/Commands/Dev/Core.hs                      |  4 +-
 app/Main.hs                                   | 87 ++++++++++++-------
 src/Juvix/Compiler/Core/Error.hs              |  2 +-
 src/Juvix/Compiler/Core/Evaluator.hs          | 60 +++++++++----
 src/Juvix/Compiler/Core/Language/Builtins.hs  |  8 ++
 .../Core/Language/Info/NoDisplayInfo.hs       | 10 +++
 src/Juvix/Compiler/Core/Pretty.hs             |  3 +
 src/Juvix/Compiler/Core/Pretty/Base.hs        |  6 +-
 .../Compiler/Core/Translation/FromSource.hs   | 26 +++++-
 .../Core/Translation/FromSource/Lexer.hs      |  6 +-
 src/Juvix/Extra/Strings.hs                    |  3 +
 11 files changed, 163 insertions(+), 52 deletions(-)
 create mode 100644 src/Juvix/Compiler/Core/Language/Info/NoDisplayInfo.hs

diff --git a/app/Commands/Dev/Core.hs b/app/Commands/Dev/Core.hs
index 22bcd63a9a..b0a54f20df 100644
--- a/app/Commands/Dev/Core.hs
+++ b/app/Commands/Dev/Core.hs
@@ -4,7 +4,7 @@ import Juvix.Prelude hiding (Doc)
 import Options.Applicative
 
 data CoreCommand
-  = Repl CoreEvalOptions
+  = Repl
   | Eval CoreEvalOptions
 
 newtype CoreEvalOptions = CoreEvalOptions
@@ -36,7 +36,7 @@ parseCoreCommand =
     replInfo :: ParserInfo CoreCommand
     replInfo =
       info
-        (Repl <$> parseCoreEvalOptions)
+        (pure Repl)
         (progDesc "Start an interactive session of the JuvixCore evaluator")
 
     evalInfo :: ParserInfo CoreCommand
diff --git a/app/Main.hs b/app/Main.hs
index 8c45e1aac5..0d246580b4 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -26,6 +26,9 @@ import Juvix.Compiler.Concrete.Translation.FromSource qualified as Parser
 import Juvix.Compiler.Core.Data.InfoTable qualified as Core
 import Juvix.Compiler.Core.Error qualified as Core
 import Juvix.Compiler.Core.Evaluator qualified as Core
+import Juvix.Compiler.Core.Extra.Base qualified as Core
+import Juvix.Compiler.Core.Language.Info qualified as Info
+import Juvix.Compiler.Core.Language.Info.NoDisplayInfo qualified as Info
 import Juvix.Compiler.Core.Language qualified as Core
 import Juvix.Compiler.Core.Pretty qualified as Core
 import Juvix.Compiler.Core.Translation.FromSource qualified as Core
@@ -274,20 +277,20 @@ runCommand cmdWithOpts = do
 
 runCoreCommand :: Members '[Embed IO, App] r => GlobalOptions -> CoreCommand -> Sem r ()
 runCoreCommand globalOpts = \case
-  Repl opts -> do
+  Repl -> do
     embed showReplWelcome
-    runRepl opts Core.emptyInfoTable
-  Eval _ ->
+    runRepl Core.emptyInfoTable
+  Eval opts ->
     case globalOpts ^. globalInputFiles of
       [] -> printFailureExit "Provide a JuvixCore file to run this command\nUse --help to see all the options"
-      files -> mapM_ evalFile files
+      files -> mapM_ (evalFile opts) files
   where
     runRepl ::
+      forall r.
       Members '[Embed IO, App] r =>
-      CoreEvalOptions ->
       Core.InfoTable ->
       Sem r ()
-    runRepl opts tab = do
+    runRepl tab = do
       embed (putStr "> ")
       embed (hFlush stdout)
       done <- embed isEOF
@@ -297,37 +300,53 @@ runCoreCommand globalOpts = \case
           ":q" -> return ()
           ":h" -> do
             embed showReplHelp
-            runRepl opts tab
+            runRepl tab
           ':' : 'p' : ' ' : s' ->
             case Core.parseText tab (fromString s') of
               Left err -> do
                 printJuvixError (JuvixError err)
-                runRepl opts tab
+                runRepl tab
               Right (tab', Just node) -> do
                 renderStdOut (Core.ppOutDefault node)
                 embed (putStrLn "")
-                runRepl opts tab'
+                runRepl tab'
               Right (tab', Nothing) ->
-                runRepl opts tab'
+                runRepl tab'
+          ':' : 'e' : ' ' : s' ->
+            case Core.parseText tab (fromString s') of
+              Left err -> do
+                printJuvixError (JuvixError err)
+                runRepl tab
+              Right (tab', Just node) ->
+                replEval True tab' node
+              Right (tab', Nothing) ->
+                runRepl tab'
           _ ->
             case Core.parseText tab s of
               Left err -> do
                 printJuvixError (JuvixError err)
-                runRepl opts tab
-              Right (tab', Just node) -> do
-                r <- doEval defaultLoc tab' node
-                case r of
-                  Left err -> do
-                    printJuvixError (JuvixError err)
-                    runRepl opts tab'
-                  Right node' -> do
-                    renderStdOut (Core.ppOutDefault node')
-                    embed (putStrLn "")
-                    runRepl opts tab'
+                runRepl tab
+              Right (tab', Just node) ->
+                replEval False tab' node
               Right (tab', Nothing) ->
-                runRepl opts tab'
+                runRepl tab'
       where
-        defaultLoc = singletonInterval (mkLoc "stdin" 0 (M.initialPos "stdin"))
+        replEval :: Bool -> Core.InfoTable -> Core.Node -> Sem r ()
+        replEval noIO tab' node = do
+          r <- doEval noIO defaultLoc tab' node
+          case r of
+            Left err -> do
+              printJuvixError (JuvixError err)
+              runRepl tab'
+            Right node'
+              | Info.member Info.kNoDisplayInfo (Core.getInfo node') ->
+                  runRepl tab'
+            Right node' -> do
+              renderStdOut (Core.ppOutDefault node')
+              embed (putStrLn "")
+              runRepl tab'
+          where
+            defaultLoc = singletonInterval (mkLoc "stdin" 0 (M.initialPos "stdin"))
 
     showReplWelcome :: IO ()
     showReplWelcome = do
@@ -342,18 +361,21 @@ runCoreCommand globalOpts = \case
       putStrLn "JuvixCore REPL"
       putStrLn ""
       putStrLn "Type in a JuvixCore program to evaluate."
-      putStrLn "Type \":q\" to quit."
-      putStrLn "Type \":p expr\" to pretty print \"expr\"."
-      putStrLn "Type \":h\" to display this help message."
+      putStrLn ""
+      putStrLn "Available commands:"
+      putStrLn ":p expr               Pretty print \"expr\"."
+      putStrLn ":e expr               Evaluate \"expr\" without interpreting IO actions."
+      putStrLn ":q                    Quit."
+      putStrLn ":h                    Display this help message."
       putStrLn ""
 
-    evalFile :: Members '[Embed IO, App] r => FilePath -> Sem r ()
-    evalFile f = do
+    evalFile :: Members '[Embed IO, App] r => CoreEvalOptions -> FilePath -> Sem r ()
+    evalFile opts f = do
       s <- embed (readFile f)
       case Core.runParser "" f Core.emptyInfoTable s of
         Left err -> exitJuvixError (JuvixError err)
         Right (tab, Just node) -> do
-          r <- doEval defaultLoc tab node
+          r <- doEval (opts ^. coreEvalNoIO) defaultLoc tab node
           case r of
             Left err -> exitJuvixError (JuvixError err)
             Right node' -> do
@@ -365,12 +387,15 @@ runCoreCommand globalOpts = \case
 
     doEval ::
       Members '[Embed IO, App] r =>
+      Bool ->
       Interval ->
       Core.InfoTable ->
       Core.Node ->
       Sem r (Either Core.CoreError Core.Node)
-    doEval loc tab node =
-      embed (Core.catchEvalError loc (Core.eval (tab ^. Core.identContext) [] node))
+    doEval noIO loc tab node =
+      if noIO
+        then embed $ Core.catchEvalError loc (Core.eval (tab ^. Core.identContext) [] node)
+        else embed $ Core.catchEvalErrorIO loc (Core.evalIO (tab ^. Core.identContext) [] node)
 
 showHelpText :: ParserPrefs -> IO ()
 showHelpText p = do
diff --git a/src/Juvix/Compiler/Core/Error.hs b/src/Juvix/Compiler/Core/Error.hs
index 7ddc72b41c..0f29965eda 100644
--- a/src/Juvix/Compiler/Core/Error.hs
+++ b/src/Juvix/Compiler/Core/Error.hs
@@ -23,7 +23,7 @@ instance ToGenericError CoreError where
 
 instance Pretty CoreError where
   pretty (CoreError {..}) = case _coreErrorNode of
-    Just node -> pretty _coreErrorMsg <> colon <> line <> pretty (ppOutDefault node)
+    Just node -> pretty _coreErrorMsg <> colon <> space <> pretty (ppTrace node)
     Nothing -> pretty _coreErrorMsg
 
 instance HasLoc CoreError where
diff --git a/src/Juvix/Compiler/Core/Evaluator.hs b/src/Juvix/Compiler/Core/Evaluator.hs
index 17e79afeab..64858114fc 100644
--- a/src/Juvix/Compiler/Core/Evaluator.hs
+++ b/src/Juvix/Compiler/Core/Evaluator.hs
@@ -8,17 +8,18 @@ module Juvix.Compiler.Core.Evaluator where
 
 import Control.Exception qualified as Exception
 import Data.HashMap.Strict qualified as HashMap
-import GHC.Show
+import GHC.Show as S
 import Juvix.Compiler.Core.Data.InfoTable
 import Juvix.Compiler.Core.Error
 import Juvix.Compiler.Core.Extra
 import Juvix.Compiler.Core.Language
 import Juvix.Compiler.Core.Language.Info qualified as Info
+import Juvix.Compiler.Core.Language.Info.NoDisplayInfo
 import Juvix.Compiler.Core.Pretty
 
 data EvalError = EvalError
-  { _evalErrorMsg :: Text,
-    _evalErrorNode :: Node
+  { _evalErrorMsg :: !Text,
+    _evalErrorNode :: !Node
   }
 
 makeLenses ''EvalError
@@ -47,7 +48,7 @@ eval :: IdentContext -> Env -> Node -> Node
 eval !ctx !env0 = convertRuntimeNodes . eval' env0
   where
     evalError :: Text -> Node -> a
-    evalError msg node = Exception.throw (EvalError msg node)
+    evalError !msg !node = Exception.throw (EvalError msg node)
 
     eval' :: Env -> Node -> Node
     eval' !env !n = case n of
@@ -113,18 +114,47 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
         Just n' -> n'
         Nothing -> Suspended Info.empty n
 
+-- Evaluate `node` and interpret the builtin IO actions.
+evalIO :: IdentContext -> Env -> Node -> IO Node
+evalIO ctx env node =
+  case eval ctx env node of
+    ConstrApp _ (BuiltinTag TagReturn) [x] ->
+      return x
+    ConstrApp _ (BuiltinTag TagBind) [x, f] -> do
+      x' <- evalIO ctx env x
+      evalIO ctx env (App Info.empty f x')
+    ConstrApp _ (BuiltinTag TagWrite) [Constant _ (ConstString s)] -> do
+      putStr s
+      return unitNode
+    ConstrApp _ (BuiltinTag TagWrite) [arg] -> do
+      putStr (ppPrint arg)
+      return unitNode
+    ConstrApp _ (BuiltinTag TagReadLn) [] -> do
+      hFlush stdout
+      Constant Info.empty . ConstString <$> getLine
+    _ ->
+      return node
+  where
+    unitNode = ConstrApp (Info.singleton (NoDisplayInfo ())) (BuiltinTag TagNil) []
+
 -- Catch EvalError and convert it to CoreError. Needs a default location in case
 -- no location is available in EvalError.
 catchEvalError :: Location -> a -> IO (Either CoreError a)
-catchEvalError loc a = do
+catchEvalError loc a =
   Exception.catch
-    (return (Right a))
-    (\(ex :: EvalError) -> return (Left (toCoreError ex)))
-  where
-    toCoreError :: EvalError -> CoreError
-    toCoreError (EvalError {..}) =
-      CoreError
-        { _coreErrorMsg = _evalErrorMsg,
-          _coreErrorNode = Just _evalErrorNode,
-          _coreErrorLoc = fromMaybe loc (lookupLocation _evalErrorNode)
-        }
+    (Exception.evaluate a <&> Right)
+    (\(ex :: EvalError) -> return (Left (toCoreError loc ex)))
+
+catchEvalErrorIO :: Location -> IO a -> IO (Either CoreError a)
+catchEvalErrorIO loc ma =
+  Exception.catch
+    (Exception.evaluate ma >>= \ma' -> ma' <&> Right)
+    (\(ex :: EvalError) -> return (Left (toCoreError loc ex)))
+
+toCoreError :: Location -> EvalError -> CoreError
+toCoreError loc (EvalError {..}) =
+  CoreError
+    { _coreErrorMsg = mappend "evaluation error: " _evalErrorMsg,
+      _coreErrorNode = Just _evalErrorNode,
+      _coreErrorLoc = fromMaybe loc (lookupLocation _evalErrorNode)
+    }
diff --git a/src/Juvix/Compiler/Core/Language/Builtins.hs b/src/Juvix/Compiler/Core/Language/Builtins.hs
index df08cb2d93..53a957dccd 100644
--- a/src/Juvix/Compiler/Core/Language/Builtins.hs
+++ b/src/Juvix/Compiler/Core/Language/Builtins.hs
@@ -18,6 +18,10 @@ data BuiltinOp
 data BuiltinDataTag
   = TagNil
   | TagCons
+  | TagReturn
+  | TagBind
+  | TagWrite
+  | TagReadLn
   deriving stock (Eq, Generic)
 
 instance Hashable BuiltinDataTag
@@ -36,3 +40,7 @@ builtinConstrArgsNum :: BuiltinDataTag -> Int
 builtinConstrArgsNum = \case
   TagNil -> 0
   TagCons -> 2
+  TagReturn -> 1
+  TagBind -> 2
+  TagWrite -> 1
+  TagReadLn -> 0
diff --git a/src/Juvix/Compiler/Core/Language/Info/NoDisplayInfo.hs b/src/Juvix/Compiler/Core/Language/Info/NoDisplayInfo.hs
new file mode 100644
index 0000000000..92a103ed17
--- /dev/null
+++ b/src/Juvix/Compiler/Core/Language/Info/NoDisplayInfo.hs
@@ -0,0 +1,10 @@
+module Juvix.Compiler.Core.Language.Info.NoDisplayInfo where
+
+import Juvix.Compiler.Core.Language.Base
+
+newtype NoDisplayInfo = NoDisplayInfo ()
+
+instance IsInfo NoDisplayInfo
+
+kNoDisplayInfo :: Key NoDisplayInfo
+kNoDisplayInfo = Proxy
diff --git a/src/Juvix/Compiler/Core/Pretty.hs b/src/Juvix/Compiler/Core/Pretty.hs
index 00ae60469e..4c8a856137 100644
--- a/src/Juvix/Compiler/Core/Pretty.hs
+++ b/src/Juvix/Compiler/Core/Pretty.hs
@@ -20,3 +20,6 @@ ppOut o = AnsiText . PPOutput . doc o
 
 ppTrace :: PrettyCode c => c -> Text
 ppTrace = Ansi.renderStrict . reAnnotateS stylize . layoutPretty defaultLayoutOptions . doc defaultOptions
+
+ppPrint :: PrettyCode c => c -> Text
+ppPrint = show . ppOutDefault
diff --git a/src/Juvix/Compiler/Core/Pretty/Base.hs b/src/Juvix/Compiler/Core/Pretty/Base.hs
index fd73ac5d25..f556c38e37 100644
--- a/src/Juvix/Compiler/Core/Pretty/Base.hs
+++ b/src/Juvix/Compiler/Core/Pretty/Base.hs
@@ -49,6 +49,10 @@ instance PrettyCode BuiltinDataTag where
   ppCode = \case
     TagNil -> return $ annotate (AnnKind KNameConstructor) (pretty ("nil" :: String))
     TagCons -> return $ annotate (AnnKind KNameConstructor) (pretty ("cons" :: String))
+    TagReturn -> return $ annotate (AnnKind KNameConstructor) (pretty ("return" :: String))
+    TagBind -> return $ annotate (AnnKind KNameConstructor) (pretty ("bind" :: String))
+    TagWrite -> return $ annotate (AnnKind KNameConstructor) (pretty ("write" :: String))
+    TagReadLn -> return $ annotate (AnnKind KNameConstructor) (pretty ("readLn" :: String))
 
 instance PrettyCode Tag where
   ppCode = \case
@@ -72,7 +76,7 @@ instance PrettyCode Node where
     Constant _ (ConstBool False) ->
       return $ annotate (AnnKind KNameConstructor) (pretty ("false" :: String))
     Constant _ (ConstString txt) ->
-      return $ annotate AnnLiteralString (pretty ("\"" ++ fromText txt ++ "\""))
+      return $ annotate AnnLiteralString (pretty (show txt :: String))
     Axiom {..} ->
       case Info.lookup kNameInfo axiomInfo of
         Just ni -> ppCode (ni ^. NameInfo.infoName)
diff --git a/src/Juvix/Compiler/Core/Translation/FromSource.hs b/src/Juvix/Compiler/Core/Translation/FromSource.hs
index e458c6b2da..cef535e374 100644
--- a/src/Juvix/Compiler/Core/Translation/FromSource.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromSource.hs
@@ -85,6 +85,10 @@ declareBuiltins = do
   let i = mkInterval loc loc
   lift $ declareBuiltinConstr TagNil "nil" i
   lift $ declareBuiltinConstr TagCons "cons" i
+  lift $ declareBuiltinConstr TagReturn "return" i
+  lift $ declareBuiltinConstr TagBind "bind" i
+  lift $ declareBuiltinConstr TagWrite "write" i
+  lift $ declareBuiltinConstr TagReadLn "readLn" i
 
 parseToplevel ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
@@ -193,7 +197,27 @@ expr ::
   -- reverse de Bruijn indices
   HashMap Text Index ->
   ParsecS r Node
-expr varsNum vars = cmpExpr varsNum vars
+expr varsNum vars = bindExpr varsNum vars
+
+bindExpr ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Index ->
+  HashMap Text Index ->
+  ParsecS r Node
+bindExpr varsNum vars = do
+  node <- cmpExpr varsNum vars
+  bindExpr' varsNum vars node <|> return node
+
+bindExpr' ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Index ->
+  HashMap Text Index ->
+  Node ->
+  ParsecS r Node
+bindExpr' varsNum vars node = do
+  kwBind
+  node' <- bindExpr varsNum vars
+  return $ ConstrApp Info.empty (BuiltinTag TagBind) [node, node']
 
 cmpExpr ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
diff --git a/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs b/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs
index 95ad140e1f..2f945028cc 100644
--- a/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs
@@ -81,7 +81,8 @@ allKeywords =
     kwLt,
     kwLe,
     kwGt,
-    kwGe
+    kwGe,
+    kwBind
   ]
 
 lbrace :: ParsecS r ()
@@ -185,3 +186,6 @@ kwGt = keyword Str.greater
 
 kwGe :: ParsecS r ()
 kwGe = keyword Str.greaterEqual
+
+kwBind :: ParsecS r ()
+kwBind = keyword Str.bind
\ No newline at end of file
diff --git a/src/Juvix/Extra/Strings.hs b/src/Juvix/Extra/Strings.hs
index 9b0d353c79..9fa99c9fde 100644
--- a/src/Juvix/Extra/Strings.hs
+++ b/src/Juvix/Extra/Strings.hs
@@ -143,6 +143,9 @@ greater = ">"
 greaterEqual :: IsString s => s
 greaterEqual = ">="
 
+bind :: IsString s => s
+bind = ">>="
+
 data_ :: IsString s => s
 data_ = "data"
 

From 4c23f2bd7c90ee4be21d52cd64df84014b9f8122 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Mon, 15 Aug 2022 13:59:45 +0200
Subject: [PATCH 50/85] comment

---
 src/Juvix/Compiler/Core/Translation/FromSource.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/src/Juvix/Compiler/Core/Translation/FromSource.hs b/src/Juvix/Compiler/Core/Translation/FromSource.hs
index cef535e374..82c7ca234d 100644
--- a/src/Juvix/Compiler/Core/Translation/FromSource.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromSource.hs
@@ -21,6 +21,9 @@ import Text.Megaparsec qualified as P
 parseText :: InfoTable -> Text -> Either ParserError (InfoTable, Maybe Node)
 parseText = runParser "" ""
 
+-- Note: only new symbols and tags that are not in the InfoTable already will be
+-- generated during parsing, but nameIds are generated starting from 0
+-- regardless of the names already in the InfoTable
 runParser :: FilePath -> FilePath -> InfoTable -> Text -> Either ParserError (InfoTable, Maybe Node)
 runParser root fileName tab input =
   case run $

From e4839e4fa16642e92cafd9a2c5b81ac6dc400c76 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Mon, 15 Aug 2022 16:16:56 +0200
Subject: [PATCH 51/85] small changes

---
 app/Main.hs                                           |  2 +-
 src/Juvix/Compiler/Core/Evaluator.hs                  | 11 +++++++----
 src/Juvix/Compiler/Core/Extra.hs                      |  6 +++---
 src/Juvix/Compiler/Core/Language.hs                   |  8 +++++---
 .../Compiler/Core/Translation/FromSource/Lexer.hs     |  2 +-
 5 files changed, 17 insertions(+), 12 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 0d246580b4..c61fe89cf6 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -27,9 +27,9 @@ import Juvix.Compiler.Core.Data.InfoTable qualified as Core
 import Juvix.Compiler.Core.Error qualified as Core
 import Juvix.Compiler.Core.Evaluator qualified as Core
 import Juvix.Compiler.Core.Extra.Base qualified as Core
+import Juvix.Compiler.Core.Language qualified as Core
 import Juvix.Compiler.Core.Language.Info qualified as Info
 import Juvix.Compiler.Core.Language.Info.NoDisplayInfo qualified as Info
-import Juvix.Compiler.Core.Language qualified as Core
 import Juvix.Compiler.Core.Pretty qualified as Core
 import Juvix.Compiler.Core.Translation.FromSource qualified as Core
 import Juvix.Compiler.Internal.Pretty qualified as Internal
diff --git a/src/Juvix/Compiler/Core/Evaluator.hs b/src/Juvix/Compiler/Core/Evaluator.hs
index 64858114fc..3a5c8a39a6 100644
--- a/src/Juvix/Compiler/Core/Evaluator.hs
+++ b/src/Juvix/Compiler/Core/Evaluator.hs
@@ -56,12 +56,12 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
       Ident _ sym -> eval' [] (lookupContext n sym)
       Constant {} -> n
       Axiom {} -> n
-      App _ l r ->
+      App i l r ->
         case eval' env l of
           Closure _ env' b -> let !v = eval' env r in eval' (v : env') b
           a@(Axiom {}) -> Suspended Info.empty (App Info.empty a (eval' env r))
-          Suspended i t -> Suspended i (App Info.empty t (eval' env r))
-          v -> evalError "invalid application" v
+          Suspended i' t -> Suspended i' (App Info.empty t (eval' env r))
+          v -> evalError "invalid application" (App i v (substEnv env r))
       BuiltinApp _ op args -> applyBuiltin n env op args
       ConstrApp i tag args -> Data i tag (map (eval' env) args)
       Lambda i b -> Closure i env b
@@ -91,7 +91,10 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
     applyBuiltin _ env OpIntAdd [l, r] = nodeFromInteger (integerFromNode (eval' env l) + integerFromNode (eval' env r))
     applyBuiltin _ env OpIntSub [l, r] = nodeFromInteger (integerFromNode (eval' env l) - integerFromNode (eval' env r))
     applyBuiltin _ env OpIntMul [l, r] = nodeFromInteger (integerFromNode (eval' env l) * integerFromNode (eval' env r))
-    applyBuiltin _ env OpIntDiv [l, r] = nodeFromInteger (div (integerFromNode (eval' env l)) (integerFromNode (eval' env r)))
+    applyBuiltin n env OpIntDiv [l, r] =
+      case integerFromNode (eval' env r) of
+        0 -> evalError "division by zero" (substEnv env n)
+        k -> nodeFromInteger (div (integerFromNode (eval' env l)) k)
     applyBuiltin _ env OpIntEq [l, r] = nodeFromBool (integerFromNode (eval' env l) == integerFromNode (eval' env r))
     applyBuiltin _ env OpIntLt [l, r] = nodeFromBool (integerFromNode (eval' env l) < integerFromNode (eval' env r))
     applyBuiltin _ env OpIntLe [l, r] = nodeFromBool (integerFromNode (eval' env l) <= integerFromNode (eval' env r))
diff --git a/src/Juvix/Compiler/Core/Extra.hs b/src/Juvix/Compiler/Core/Extra.hs
index dae36a3b85..ecd3851d4f 100644
--- a/src/Juvix/Compiler/Core/Extra.hs
+++ b/src/Juvix/Compiler/Core/Extra.hs
@@ -62,8 +62,8 @@ subst t = umapN go
       Var _ idx | idx == k -> shift k t
       _ -> n
 
--- reduce all beta redexes present in a term and the ones created downwards
--- (i.e., a "beta-development")
+-- reduce all beta redexes present in a term and the ones created immediately
+-- downwards (i.e., a "beta-development")
 developBeta :: Node -> Node
 developBeta = umap go
   where
@@ -74,7 +74,7 @@ developBeta = umap go
 
 -- substitution of all free variables for values in a closed environment
 substEnv :: Env -> Node -> Node
-substEnv env = umapN go
+substEnv env = if null env then id else umapN go
   where
     go k n = case n of
       Var _ idx | idx >= k -> env !! (idx - k)
diff --git a/src/Juvix/Compiler/Core/Language.hs b/src/Juvix/Compiler/Core/Language.hs
index 3487a730bd..648919b93f 100644
--- a/src/Juvix/Compiler/Core/Language.hs
+++ b/src/Juvix/Compiler/Core/Language.hs
@@ -68,7 +68,7 @@ data Node
         ifFalseBranch :: !Node
       }
   | -- Evaluation only: evaluated data constructor (the actual data). Arguments
-    -- order: right to left. Arguments are values (see below).
+    -- order: left to right. Arguments are values (see below).
     Data {dataInfo :: !Info, dataTag :: !Tag, dataArgs :: ![Node]}
   | -- Evaluation only: `Closure env body`
     Closure
@@ -104,8 +104,10 @@ data ConstantValue
 --   equal to the number of implicit binders above `branch`
 data CaseBranch = CaseBranch {caseTag :: !Tag, caseBindersNum :: !Int, caseBranch :: !Node}
 
--- Values are closed nodes (no free variables, i.e., no de Bruijn indices
--- pointing outside the term) of the following kinds:
+-- A node (term) is closed if it has no free variables, i.e., no de Bruijn
+-- indices pointing outside the term.
+
+-- Values are closed nodes of the following kinds:
 -- - Constant
 -- - Axiom
 -- - Data
diff --git a/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs b/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs
index 2f945028cc..f58cb3d069 100644
--- a/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs
@@ -188,4 +188,4 @@ kwGe :: ParsecS r ()
 kwGe = keyword Str.greaterEqual
 
 kwBind :: ParsecS r ()
-kwBind = keyword Str.bind
\ No newline at end of file
+kwBind = keyword Str.bind

From b2404dde6ce5a876fcc04ea27e47c992a675ab7f Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Tue, 16 Aug 2022 00:36:02 +0200
Subject: [PATCH 52/85] IO sequence

---
 app/Main.hs                                   |  3 ++
 .../Compiler/Core/Translation/FromSource.hs   | 30 +++++++++++++++----
 .../Core/Translation/FromSource/Lexer.hs      |  6 +++-
 src/Juvix/Extra/Strings.hs                    |  3 ++
 4 files changed, 36 insertions(+), 6 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index c61fe89cf6..4edc639fe9 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -378,6 +378,9 @@ runCoreCommand globalOpts = \case
           r <- doEval (opts ^. coreEvalNoIO) defaultLoc tab node
           case r of
             Left err -> exitJuvixError (JuvixError err)
+            Right node'
+              | Info.member Info.kNoDisplayInfo (Core.getInfo node') ->
+                  return ()
             Right node' -> do
               renderStdOut (Core.ppOutDefault node')
               embed (putStrLn "")
diff --git a/src/Juvix/Compiler/Core/Translation/FromSource.hs b/src/Juvix/Compiler/Core/Translation/FromSource.hs
index 82c7ca234d..736a53f58d 100644
--- a/src/Juvix/Compiler/Core/Translation/FromSource.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromSource.hs
@@ -209,7 +209,9 @@ bindExpr ::
   ParsecS r Node
 bindExpr varsNum vars = do
   node <- cmpExpr varsNum vars
-  bindExpr' varsNum vars node <|> return node
+  bindExpr' varsNum vars node
+    <|> seqExpr' varsNum vars node
+    <|> return node
 
 bindExpr' ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
@@ -222,6 +224,22 @@ bindExpr' varsNum vars node = do
   node' <- bindExpr varsNum vars
   return $ ConstrApp Info.empty (BuiltinTag TagBind) [node, node']
 
+seqExpr' ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Index ->
+  HashMap Text Index ->
+  Node ->
+  ParsecS r Node
+seqExpr' varsNum vars node = do
+  ((), i) <- interval kwSeq
+  node' <- bindExpr (varsNum + 1) vars
+  name <- lift $ freshName KNameLocal "_" i
+  return $
+    ConstrApp
+      Info.empty
+      (BuiltinTag TagBind)
+      [node, Lambda (Info.singleton (BinderInfo name Star)) node']
+
 cmpExpr ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
   Index ->
@@ -477,16 +495,18 @@ parseLocalName ::
   forall r.
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
   ParsecS r Name
-parseLocalName =
-  parseWildcardName <|> do
-    (txt, i) <- identifierL
-    lift $ freshName KNameLocal txt i
+parseLocalName = parseWildcardName <|> parseIdentName
   where
     parseWildcardName :: ParsecS r Name
     parseWildcardName = do
       ((), i) <- interval kwWildcard
       lift $ freshName KNameLocal "_" i
 
+    parseIdentName :: ParsecS r Name
+    parseIdentName = do
+      (txt, i) <- identifierL
+      lift $ freshName KNameLocal txt i
+
 exprLambda ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
   Index ->
diff --git a/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs b/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs
index f58cb3d069..3b980102a9 100644
--- a/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs
@@ -82,7 +82,8 @@ allKeywords =
     kwLe,
     kwGt,
     kwGe,
-    kwBind
+    kwBind,
+    kwSeq
   ]
 
 lbrace :: ParsecS r ()
@@ -189,3 +190,6 @@ kwGe = keyword Str.greaterEqual
 
 kwBind :: ParsecS r ()
 kwBind = keyword Str.bind
+
+kwSeq :: ParsecS r ()
+kwSeq = keyword Str.seq_
diff --git a/src/Juvix/Extra/Strings.hs b/src/Juvix/Extra/Strings.hs
index 9fa99c9fde..9757996910 100644
--- a/src/Juvix/Extra/Strings.hs
+++ b/src/Juvix/Extra/Strings.hs
@@ -146,6 +146,9 @@ greaterEqual = ">="
 bind :: IsString s => s
 bind = ">>="
 
+seq_ :: IsString s => s
+seq_ = ">>"
+
 data_ :: IsString s => s
 data_ = "data"
 

From 383acfac5867b106cef774c8c34bec1c2446bacb Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Tue, 16 Aug 2022 00:54:37 +0200
Subject: [PATCH 53/85] evalIO bugfix

---
 src/Juvix/Compiler/Core/Evaluator.hs | 35 ++++++++++++++--------------
 1 file changed, 18 insertions(+), 17 deletions(-)

diff --git a/src/Juvix/Compiler/Core/Evaluator.hs b/src/Juvix/Compiler/Core/Evaluator.hs
index 3a5c8a39a6..9e5595783f 100644
--- a/src/Juvix/Compiler/Core/Evaluator.hs
+++ b/src/Juvix/Compiler/Core/Evaluator.hs
@@ -120,23 +120,24 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
 -- Evaluate `node` and interpret the builtin IO actions.
 evalIO :: IdentContext -> Env -> Node -> IO Node
 evalIO ctx env node =
-  case eval ctx env node of
-    ConstrApp _ (BuiltinTag TagReturn) [x] ->
-      return x
-    ConstrApp _ (BuiltinTag TagBind) [x, f] -> do
-      x' <- evalIO ctx env x
-      evalIO ctx env (App Info.empty f x')
-    ConstrApp _ (BuiltinTag TagWrite) [Constant _ (ConstString s)] -> do
-      putStr s
-      return unitNode
-    ConstrApp _ (BuiltinTag TagWrite) [arg] -> do
-      putStr (ppPrint arg)
-      return unitNode
-    ConstrApp _ (BuiltinTag TagReadLn) [] -> do
-      hFlush stdout
-      Constant Info.empty . ConstString <$> getLine
-    _ ->
-      return node
+  let node' = eval ctx env node
+   in case node' of
+        ConstrApp _ (BuiltinTag TagReturn) [x] ->
+          return x
+        ConstrApp _ (BuiltinTag TagBind) [x, f] -> do
+          x' <- evalIO ctx env x
+          evalIO ctx env (App Info.empty f x')
+        ConstrApp _ (BuiltinTag TagWrite) [Constant _ (ConstString s)] -> do
+          putStr s
+          return unitNode
+        ConstrApp _ (BuiltinTag TagWrite) [arg] -> do
+          putStr (ppPrint arg)
+          return unitNode
+        ConstrApp _ (BuiltinTag TagReadLn) [] -> do
+          hFlush stdout
+          Constant Info.empty . ConstString <$> getLine
+        _ ->
+          return node'
   where
     unitNode = ConstrApp (Info.singleton (NoDisplayInfo ())) (BuiltinTag TagNil) []
 

From e180a23e7db6ffc57b0fddf12354e6123e482a2a Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Tue, 16 Aug 2022 06:25:45 +0200
Subject: [PATCH 54/85] polymorphic type variables

---
 src/Juvix/Compiler/Core/Language/Type.hs          |  7 +++++--
 src/Juvix/Compiler/Core/Translation/FromSource.hs | 14 +++++++-------
 2 files changed, 12 insertions(+), 9 deletions(-)

diff --git a/src/Juvix/Compiler/Core/Language/Type.hs b/src/Juvix/Compiler/Core/Language/Type.hs
index e7effb0dca..9bd056f4ac 100644
--- a/src/Juvix/Compiler/Core/Language/Type.hs
+++ b/src/Juvix/Compiler/Core/Language/Type.hs
@@ -2,8 +2,11 @@ module Juvix.Compiler.Core.Language.Type where
 
 import Juvix.Compiler.Core.Language.Base
 
--- Star (*) allows to specify the type partially, e.g.: * -> * -> *.
-data Type = Atomic Atom | Fun Type Type | Universe | Star
+{-
+- TyVar indicates a polymorphic type variable
+- Atomic indicates an atom: e.g. an inductive type applied to type arguments
+-}
+data Type = TyVar Int | Universe Int | Atomic Atom | Fun Type Type
 
 data Atom = Atom
   { _atomHead :: Name,
diff --git a/src/Juvix/Compiler/Core/Translation/FromSource.hs b/src/Juvix/Compiler/Core/Translation/FromSource.hs
index 736a53f58d..c9ec89a69e 100644
--- a/src/Juvix/Compiler/Core/Translation/FromSource.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromSource.hs
@@ -68,7 +68,7 @@ declareBuiltinConstr btag nameTxt i = do
     ( ConstructorInfo
         { _constructorName = name,
           _constructorTag = BuiltinTag btag,
-          _constructorType = Star,
+          _constructorType = TyVar 0,
           _constructorArgsNum = builtinConstrArgsNum btag
         }
     )
@@ -132,7 +132,7 @@ statementDef = do
             IdentInfo
               { _identName = name,
                 _identSymbol = sym,
-                _identType = Star,
+                _identType = TyVar 0,
                 _identArgsNum = 0,
                 _identArgsInfo = [],
                 _identIsExported = False
@@ -180,7 +180,7 @@ statementConstr = do
         ConstructorInfo
           { _constructorName = name,
             _constructorTag = tag,
-            _constructorType = Star,
+            _constructorType = TyVar 0,
             _constructorArgsNum = argsNum
           }
   lift $ registerConstructor info
@@ -238,7 +238,7 @@ seqExpr' varsNum vars node = do
     ConstrApp
       Info.empty
       (BuiltinTag TagBind)
-      [node, Lambda (Info.singleton (BinderInfo name Star)) node']
+      [node, Lambda (Info.singleton (BinderInfo name (TyVar 0))) node']
 
 cmpExpr ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
@@ -517,7 +517,7 @@ exprLambda varsNum vars = do
   name <- parseLocalName
   let vars' = HashMap.insert (name ^. nameText) varsNum vars
   body <- expr (varsNum + 1) vars'
-  return $ Lambda (Info.singleton (BinderInfo name Star)) body
+  return $ Lambda (Info.singleton (BinderInfo name (TyVar 0))) body
 
 exprLet ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
@@ -532,7 +532,7 @@ exprLet varsNum vars = do
   kwIn
   let vars' = HashMap.insert (name ^. nameText) varsNum vars
   body <- expr (varsNum + 1) vars'
-  return $ Let (Info.singleton (BinderInfo name Star)) value body
+  return $ Let (Info.singleton (BinderInfo name (TyVar 0))) value body
 
 exprCase ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
@@ -561,7 +561,7 @@ exprCase' off value varsNum vars = do
   let bss = map fst bs'
   let bsns = map snd bs'
   let def' = map fromRight' $ filter isRight bs
-  let bi = CaseBinderInfo $ map (map (`BinderInfo` Star)) bsns
+  let bi = CaseBinderInfo $ map (map (`BinderInfo` TyVar 0)) bsns
   bri <-
     CaseBranchInfo
       <$> mapM

From 95e99226e421b8487c53519551731bae058c201b Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Tue, 16 Aug 2022 06:55:36 +0200
Subject: [PATCH 55/85] case bugfixes

---
 src/Juvix/Compiler/Core/Evaluator.hs              | 6 +++++-
 src/Juvix/Compiler/Core/Pretty/Base.hs            | 8 ++++----
 src/Juvix/Compiler/Core/Translation/FromSource.hs | 1 -
 3 files changed, 9 insertions(+), 6 deletions(-)

diff --git a/src/Juvix/Compiler/Core/Evaluator.hs b/src/Juvix/Compiler/Core/Evaluator.hs
index 9e5595783f..8628b3cbe7 100644
--- a/src/Juvix/Compiler/Core/Evaluator.hs
+++ b/src/Juvix/Compiler/Core/Evaluator.hs
@@ -68,7 +68,7 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
       Let _ v b -> let !v' = eval' env v in eval' (v' : env) b
       Case _ v bs def ->
         case eval' env v of
-          Data _ tag args -> branch n env (args ++ env) tag def bs
+          Data _ tag args -> branch n env (revAppend args env) tag def bs
           v' -> evalError "matching on non-data" v'
       If _ v b1 b2 ->
         case eval' env v of
@@ -117,6 +117,10 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
         Just n' -> n'
         Nothing -> Suspended Info.empty n
 
+    revAppend :: [a] -> [a] -> [a]
+    revAppend [] ys = ys
+    revAppend (x : xs) ys = revAppend xs (x : ys)
+
 -- Evaluate `node` and interpret the builtin IO actions.
 evalIO :: IdentContext -> Env -> Node -> IO Node
 evalIO ctx env node =
diff --git a/src/Juvix/Compiler/Core/Pretty/Base.hs b/src/Juvix/Compiler/Core/Pretty/Base.hs
index f556c38e37..20f800b20a 100644
--- a/src/Juvix/Compiler/Core/Pretty/Base.hs
+++ b/src/Juvix/Compiler/Core/Pretty/Base.hs
@@ -128,15 +128,15 @@ instance PrettyCode Node where
           Nothing -> mapM (\(CaseBranch tag _ _) -> ppCode tag) caseBranches
       let bs = map (\(CaseBranch _ _ br) -> br) caseBranches
       v <- ppCode caseValue
-      bs' <- sequence $ zipWith3Exact (\cn bn br -> ppCode br >>= \br' -> return $ foldl (<+>) cn bn <+> kwArrow <+> br') cns bns bs
+      bs' <- sequence $ zipWith3Exact (\cn bn br -> ppCode br >>= \br' -> return $ foldl (<+>) cn bn <+> kwMapsto <+> br') cns bns bs
       bs'' <-
         case caseDefault of
           Just def -> do
             d' <- ppCode def
-            return $ bs' ++ [kwDefault <+> kwArrow <+> d']
+            return $ bs' ++ [kwDefault <+> kwMapsto <+> d']
           Nothing -> return bs'
-      let bss = bracesIndent $ align $ concatWith (\a b -> a <> line <> b <> kwSemicolon) bs''
-      return $ kwCase <+> v <+> kwOf <> bss
+      let bss = bracesIndent $ align $ concatWith (\a b -> a <> kwSemicolon <> line <> b) bs''
+      return $ kwCase <+> v <+> kwOf <+> bss
     If {..} -> do
       v <- ppCode ifValue
       b1 <- ppCode ifTrueBranch
diff --git a/src/Juvix/Compiler/Core/Translation/FromSource.hs b/src/Juvix/Compiler/Core/Translation/FromSource.hs
index c9ec89a69e..c39ff5117a 100644
--- a/src/Juvix/Compiler/Core/Translation/FromSource.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromSource.hs
@@ -556,7 +556,6 @@ exprCase' ::
   ParsecS r Node
 exprCase' off value varsNum vars = do
   bs <- P.sepEndBy (caseBranch varsNum vars) kwSemicolon
-  rbrace
   let bs' = map fromLeft' $ filter isLeft bs
   let bss = map fst bs'
   let bsns = map snd bs'

From 0d8d0910ad7be592061ec993f3246fbe0a5de596 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Tue, 16 Aug 2022 07:09:59 +0200
Subject: [PATCH 56/85] some tests

---
 tests/Core/positive/out/test001.out |  1 +
 tests/Core/positive/out/test002.out |  1 +
 tests/Core/positive/out/test003.out |  0
 tests/Core/positive/out/test004.out |  1 +
 tests/Core/positive/out/test005.out |  1 +
 tests/Core/positive/out/test006.out |  1 +
 tests/Core/positive/out/test007.out |  7 +++++++
 tests/Core/positive/out/test008.out |  1 +
 tests/Core/positive/test001.jvc     |  1 +
 tests/Core/positive/test002.jvc     |  1 +
 tests/Core/positive/test003.jvc     |  9 +++++++++
 tests/Core/positive/test004.jvc     |  8 ++++++++
 tests/Core/positive/test005.jvc     |  7 +++++++
 tests/Core/positive/test006.jvc     |  5 +++++
 tests/Core/positive/test007.jvc     | 20 ++++++++++++++++++++
 tests/Core/positive/test008.jvc     |  5 +++++
 16 files changed, 69 insertions(+)
 create mode 100644 tests/Core/positive/out/test001.out
 create mode 100644 tests/Core/positive/out/test002.out
 create mode 100644 tests/Core/positive/out/test003.out
 create mode 100644 tests/Core/positive/out/test004.out
 create mode 100644 tests/Core/positive/out/test005.out
 create mode 100644 tests/Core/positive/out/test006.out
 create mode 100644 tests/Core/positive/out/test007.out
 create mode 100644 tests/Core/positive/out/test008.out
 create mode 100644 tests/Core/positive/test001.jvc
 create mode 100644 tests/Core/positive/test002.jvc
 create mode 100644 tests/Core/positive/test003.jvc
 create mode 100644 tests/Core/positive/test004.jvc
 create mode 100644 tests/Core/positive/test005.jvc
 create mode 100644 tests/Core/positive/test006.jvc
 create mode 100644 tests/Core/positive/test007.jvc
 create mode 100644 tests/Core/positive/test008.jvc

diff --git a/tests/Core/positive/out/test001.out b/tests/Core/positive/out/test001.out
new file mode 100644
index 0000000000..b4de394767
--- /dev/null
+++ b/tests/Core/positive/out/test001.out
@@ -0,0 +1 @@
+11
diff --git a/tests/Core/positive/out/test002.out b/tests/Core/positive/out/test002.out
new file mode 100644
index 0000000000..b4de394767
--- /dev/null
+++ b/tests/Core/positive/out/test002.out
@@ -0,0 +1 @@
+11
diff --git a/tests/Core/positive/out/test003.out b/tests/Core/positive/out/test003.out
new file mode 100644
index 0000000000..e69de29bb2
diff --git a/tests/Core/positive/out/test004.out b/tests/Core/positive/out/test004.out
new file mode 100644
index 0000000000..e56e15bb7d
--- /dev/null
+++ b/tests/Core/positive/out/test004.out
@@ -0,0 +1 @@
+12345
diff --git a/tests/Core/positive/out/test005.out b/tests/Core/positive/out/test005.out
new file mode 100644
index 0000000000..1e8b314962
--- /dev/null
+++ b/tests/Core/positive/out/test005.out
@@ -0,0 +1 @@
+6
diff --git a/tests/Core/positive/out/test006.out b/tests/Core/positive/out/test006.out
new file mode 100644
index 0000000000..d00491fd7e
--- /dev/null
+++ b/tests/Core/positive/out/test006.out
@@ -0,0 +1 @@
+1
diff --git a/tests/Core/positive/out/test007.out b/tests/Core/positive/out/test007.out
new file mode 100644
index 0000000000..a4f2b94cf5
--- /dev/null
+++ b/tests/Core/positive/out/test007.out
@@ -0,0 +1,7 @@
+false
+true
+0
+cons 1 nil
+1
+cons 1 (cons 2 nil)
+cons 1 (cons 2 nil)
diff --git a/tests/Core/positive/out/test008.out b/tests/Core/positive/out/test008.out
new file mode 100644
index 0000000000..b9d569380c
--- /dev/null
+++ b/tests/Core/positive/out/test008.out
@@ -0,0 +1 @@
+50005000
diff --git a/tests/Core/positive/test001.jvc b/tests/Core/positive/test001.jvc
new file mode 100644
index 0000000000..aa142fc941
--- /dev/null
+++ b/tests/Core/positive/test001.jvc
@@ -0,0 +1 @@
+5 + 2 * 3
diff --git a/tests/Core/positive/test002.jvc b/tests/Core/positive/test002.jvc
new file mode 100644
index 0000000000..104766618b
--- /dev/null
+++ b/tests/Core/positive/test002.jvc
@@ -0,0 +1 @@
+(\x \y \z z + x * y) 2 3 5
diff --git a/tests/Core/positive/test003.jvc b/tests/Core/positive/test003.jvc
new file mode 100644
index 0000000000..248dae302c
--- /dev/null
+++ b/tests/Core/positive/test003.jvc
@@ -0,0 +1,9 @@
+-- Empty file with comments
+
+{-
+
+Multiline comment
+
+{- nested comments don't work -- }
+
+-}
diff --git a/tests/Core/positive/test004.jvc b/tests/Core/positive/test004.jvc
new file mode 100644
index 0000000000..2527c9882c
--- /dev/null
+++ b/tests/Core/positive/test004.jvc
@@ -0,0 +1,8 @@
+-- Test IO builtins
+
+write 1 >>
+write 2 >>
+write 3 >>
+write 4 >>
+write 5 >>
+write "\n"
diff --git a/tests/Core/positive/test005.jvc b/tests/Core/positive/test005.jvc
new file mode 100644
index 0000000000..daceedb331
--- /dev/null
+++ b/tests/Core/positive/test005.jvc
@@ -0,0 +1,7 @@
+-- Higher-order functions
+
+def S := \x \y \z x z (y z);
+def K := \x \y x;
+def I := S K K;
+
+I 1 + I I 1 + I (I 1) + I I I 1 + I (I I) I (I I I) 1 + I I I (I I I (I I)) I (I I) I I I 1
diff --git a/tests/Core/positive/test006.jvc b/tests/Core/positive/test006.jvc
new file mode 100644
index 0000000000..71ed2233bc
--- /dev/null
+++ b/tests/Core/positive/test006.jvc
@@ -0,0 +1,5 @@
+-- if then else
+
+def loop := loop;
+
+if 3 > 0 then 1 else loop
diff --git a/tests/Core/positive/test007.jvc b/tests/Core/positive/test007.jvc
new file mode 100644
index 0000000000..3aea6fa70b
--- /dev/null
+++ b/tests/Core/positive/test007.jvc
@@ -0,0 +1,20 @@
+-- case
+
+def hd := \x case x of { cons x' _ -> x' };
+def tl := \x case x of { cons _ x' -> x' };
+def null := \x case x of { nil -> true; _ -> false };
+
+def map := \f \x case x of { nil -> nil; cons h t -> cons (f h) (map f t) };
+def map' := \f \x if null x then nil else cons (f (hd x)) (map' f (tl x));
+
+def lst := cons 0 (cons 1 nil);
+
+def writeLn := \x write x >> write "\n";
+
+writeLn (null lst) >>
+writeLn (null nil) >>
+writeLn (hd lst) >>
+writeLn (tl lst) >>
+writeLn (hd (tl lst)) >>
+writeLn (map (+ 1) lst) >>
+writeLn (map' (+ 1) lst)
diff --git a/tests/Core/positive/test008.jvc b/tests/Core/positive/test008.jvc
new file mode 100644
index 0000000000..360827c69b
--- /dev/null
+++ b/tests/Core/positive/test008.jvc
@@ -0,0 +1,5 @@
+-- recursion
+
+def sum := \x if x = 0 then 0 else x + sum (x - 1);
+
+sum 10000

From 493db70811ab77106e2ebfe79cc61b0fce831911 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Tue, 16 Aug 2022 17:48:06 +0200
Subject: [PATCH 57/85] several tests

---
 tests/Core/benchmark/out/test001.out |  6 ++++++
 tests/Core/benchmark/out/test002.out |  6 ++++++
 tests/Core/benchmark/test001.jvc     | 13 +++++++++++++
 tests/Core/benchmark/test002.jvc     | 13 +++++++++++++
 tests/Core/positive/out/test009.out  |  3 +++
 tests/Core/positive/out/test010.out  |  1 +
 tests/Core/positive/out/test011.out  |  3 +++
 tests/Core/positive/test009.jvc      | 28 ++++++++++++++++++++++++++++
 tests/Core/positive/test010.jvc      |  8 ++++++++
 tests/Core/positive/test011.jvc      | 24 ++++++++++++++++++++++++
 10 files changed, 105 insertions(+)
 create mode 100644 tests/Core/benchmark/out/test001.out
 create mode 100644 tests/Core/benchmark/out/test002.out
 create mode 100644 tests/Core/benchmark/test001.jvc
 create mode 100644 tests/Core/benchmark/test002.jvc
 create mode 100644 tests/Core/positive/out/test009.out
 create mode 100644 tests/Core/positive/out/test010.out
 create mode 100644 tests/Core/positive/out/test011.out
 create mode 100644 tests/Core/positive/test009.jvc
 create mode 100644 tests/Core/positive/test010.jvc
 create mode 100644 tests/Core/positive/test011.jvc

diff --git a/tests/Core/benchmark/out/test001.out b/tests/Core/benchmark/out/test001.out
new file mode 100644
index 0000000000..a114a9cf86
--- /dev/null
+++ b/tests/Core/benchmark/out/test001.out
@@ -0,0 +1,6 @@
+50005000
+5000050000
+500000500000
+50000005000000
+5000000050000000
+500000000500000000
diff --git a/tests/Core/benchmark/out/test002.out b/tests/Core/benchmark/out/test002.out
new file mode 100644
index 0000000000..d4662de4a8
--- /dev/null
+++ b/tests/Core/benchmark/out/test002.out
@@ -0,0 +1,6 @@
+55
+354224848179261915075
+43466557686937456435688527675040625802564660517371780402481729089536555417949051890403879840079255169295922593080322634775209689623239873322471161642996440906533187938298969649928516003704476137795166849228875
+33644764876431783266621612005107543310302148460680063906564769974680081442166662368155595513633734025582065332680836159373734790483865268263040892463056431887354544369559827491606602099884183933864652731300088830269235673613135117579297437854413752130520504347701602264758318906527890855154366159582987279682987510631200575428783453215515103870818298969791613127856265033195487140214287532698187962046936097879900350962302291026368131493195275630227837628441540360584402572114334961180023091208287046088923962328835461505776583271252546093591128203925285393434620904245248929403901706233888991085841065183173360437470737908552631764325733993712871937587746897479926305837065742830161637408969178426378624212835258112820516370298089332099905707920064367426202389783111470054074998459250360633560933883831923386783056136435351892133279732908133732642652633989763922723407882928177953580570993691049175470808931841056146322338217465637321248226383092103297701648054726243842374862411453093812206564914032751086643394517512161526545361333111314042436854805106765843493523836959653428071768775328348234345557366719731392746273629108210679280784718035329131176778924659089938635459327894523777674406192240337638674004021330343297496902028328145933418826817683893072003634795623117103101291953169794607632737589253530772552375943788434504067715555779056450443016640119462580972216729758615026968443146952034614932291105970676243268515992834709891284706740862008587135016260312071903172086094081298321581077282076353186624611278245537208532365305775956430072517744315051539600905168603220349163222640885248852433158051534849622434848299380905070483482449327453732624567755879089187190803662058009594743150052402532709746995318770724376825907419939632265984147498193609285223945039707165443156421328157688908058783183404917434556270520223564846495196112460268313970975069382648706613264507665074611512677522748621598642530711298441182622661057163515069260029861704945425047491378115154139941550671256271197133252763631939606902895650288268608362241082050562430701794976171121233066073310059947366875
+2597406934722172416615503402127591541488048538651769658472477070395253454351127368626555677283671674475463758722307443211163839947387509103096569738218830449305228763853133492135302679278956701051276578271635608073050532200243233114383986516137827238124777453778337299916214634050054669860390862750996639366409211890125271960172105060300350586894028558103675117658251368377438684936413457338834365158775425371912410500332195991330062204363035213756525421823998690848556374080179251761629391754963458558616300762819916081109836526352995440694284206571046044903805647136346033000520852277707554446794723709030979019014860432846819857961015951001850608264919234587313399150133919932363102301864172536477136266475080133982431231703431452964181790051187957316766834979901682011849907756686456845066287392485603914047605199550066288826345877189410680370091879365001733011710028310473947456256091444932821374855573864080579813028266640270354294412104919995803131876805899186513425175959911520563155337703996941035518275274919959802257507902037798103089922984996304496255814045517000250299764322193462165366210841876745428298261398234478366581588040819003307382939500082132009374715485131027220817305432264866949630987914714362925554252624043999615326979876807510646819068792118299167964409178271868561702918102212679267401362650499784968843680975254700131004574186406448299485872551744746695651879126916993244564817673322257149314967763345846623830333820239702436859478287641875788572910710133700300094229333597292779191409212804901545976262791057055248158884051779418192905216769576608748815567860128818354354292307397810154785701328438612728620176653953444993001980062953893698550072328665131718113588661353747268458543254898113717660519461693791688442534259478126310388952047956594380715301911253964847112638900713362856910155145342332944128435722099628674611942095166100230974070996553190050815866991144544264788287264284501725332048648319457892039984893823636745618220375097348566847433887249049337031633826571760729778891798913667325190623247118037280173921572390822769228077292456662750538337500692607721059361942126892030256744356537800831830637593334502350256972906515285327194367756015666039916404882563967693079290502951488693413799125174856667074717514938979038653338139534684837808612673755438382110844897653836848318258836339917310455850905663846202501463131183108742907729262215943020429159474030610183981685506695026197376150857176119947587572212987205312060791864980361596092339594104118635168854883911918517906151156275293615849000872150192226511785315089251027528045151238603792184692121533829287136924321527332714157478829590260157195485316444794546750285840236000238344790520345108033282013803880708980734832620122795263360677366987578332625485944906021917368867786241120562109836985019729017715780112040458649153935115783499546100636635745448508241888279067531359950519206222976015376529797308588164873117308237059828489404487403932053592935976454165560795472477862029969232956138971989467942218727360512336559521133108778758228879597580320459608479024506385194174312616377510459921102486879496341706862092908893068525234805692599833377510390101316617812305114571932706629167125446512151746802548190358351688971707570677865618800822034683632101813026232996027599403579997774046244952114531588370357904483293150007246173417355805567832153454341170020258560809166294198637401514569572272836921963229511187762530753402594781448204657460288485500062806934811398276016855584079542162057543557291510641537592939022884356120792643705560062367986544382464373946972471945996555795505838034825597839682776084731530251788951718630722761103630509360074262261717363058613291544024695432904616258691774630578507674937487992329181750163484068813465534370997589353607405172909412697657593295156818624747127636468836551757018353417274662607306510451195762866349922848678780591085118985653555434958761664016447588028633629704046289097067736256584300235314749461233912068632146637087844699210427541569410912246568571204717241133378489816764096924981633421176857150311671040068175303192115415611958042570658693127276213710697472226029655524611053715554532499750843275200199214301910505362996007042963297805103066650638786268157658772683745128976850796366371059380911225428835839194121154773759981301921650952140133306070987313732926518169226845063443954056729812031546392324981793780469103793422169495229100793029949237507299325063050942813902793084134473061411643355614764093104425918481363930542369378976520526456347648318272633371512112030629233889286487949209737847861884868260804647319539200840398308008803869049557419756219293922110825766397681361044490024720948340326796768837621396744075713887292863079821849314343879778088737958896840946143415927131757836511457828935581859902923534388888846587452130838137779443636119762839036894595760120316502279857901545344747352706972851454599861422902737291131463782045516225447535356773622793648545035710208644541208984235038908770223039849380214734809687433336225449150117411751570704561050895274000206380497967960402617818664481248547269630823473377245543390519841308769781276565916764229022948181763075710255793365008152286383634493138089971785087070863632205869018938377766063006066757732427272929247421295265000706646722730009956124191409138984675224955790729398495608750456694217771551107346630456603944136235888443676215273928597072287937355966723924613827468703217858459948257514745406436460997059316120596841560473234396652457231650317792833860590388360417691428732735703986803342604670071717363573091122981306903286137122597937096605775172964528263757434075792282180744352908669606854021718597891166333863858589736209114248432178645039479195424208191626088571069110433994801473013100869848866430721216762473119618190737820766582968280796079482259549036328266578006994856825300536436674822534603705134503603152154296943991866236857638062351209884448741138600171173647632126029961408561925599707566827866778732377419444462275399909291044697716476151118672327238679208133367306181944849396607123345271856520253643621964198782752978813060080313141817069314468221189275784978281094367751540710106350553798003842219045508482239386993296926659221112742698133062300073465628498093636693049446801628553712633412620378491919498600097200836727876650786886306933418995225768314390832484886340318940194161036979843833346608676709431643653538430912157815543512852077720858098902099586449602479491970687230765687109234380719509824814473157813780080639358418756655098501321882852840184981407690738507369535377711880388528935347600930338598691608289335421147722936561907276264603726027239320991187820407067412272258120766729040071924237930330972132364184093956102995971291799828290009539147382437802779051112030954582532888721146170133440385939654047806199333224547317803407340902512130217279595753863158148810392952475410943880555098382627633127606718126171022011356181800775400227516734144169216424973175621363128588281978005788832454534581522434937268133433997710512532081478345067139835038332901313945986481820272322043341930929011907832896569222878337497354301561722829115627329468814853281922100752373626827643152685735493223028018101449649009015529248638338885664893002250974343601200814365153625369199446709711126951966725780061891215440222487564601554632812091945824653557432047644212650790655208208337976071465127508320487165271577472325887275761128357592132553934446289433258105028633583669291828566894736223508250294964065798630809614341696830467595174355313224362664207197608459024263017473392225291248366316428006552870975051997504913009859468071013602336440164400179188610853230764991714372054467823597211760465153200163085336319351589645890681722372812310320271897917951272799656053694032111242846590994556380215461316106267521633805664394318881268199494005537068697621855231858921100963441012933535733918459668197539834284696822889460076352031688922002021931318369757556962061115774305826305535862015637891246031220672933992617378379625150999935403648731423208873977968908908369996292995391977217796533421249291978383751460062054967341662833487341011097770535898066498136011395571584328308713940582535274056081011503907941688079197212933148303072638678631411038443128215994936824342998188719768637604496342597524256886188688978980888315865076262604856465004322896856149255063968811404400429503894245872382233543101078691517328333604779262727765686076177705616874050257743749983775830143856135427273838589774133526949165483929721519554793578923866762502745370104660909382449626626935321303744538892479216161188889702077910448563199514826630802879549546453583866307344423753319712279158861707289652090149848305435983200771326653407290662016775706409690183771201306823245333477966660525325490873601961480378241566071271650383582257289215708209369510995890132859490724306183325755201208090007175022022949742801823445413711916298449914722254196594682221468260644961839254249670903104007581488857971672246322887016438403908463856731164308169537326790303114583680575021119639905615169154708510459700542098571797318015564741406172334145847111268547929892443001391468289103679179216978616582489007322033591376706527676521307143985302760988478056216994659655461379174985659739227379416726495377801992098355427866179123126699374730777730569324430166839333011554515542656864937492128687049121754245967831132969248492466744261999033972825674873460201150442228780466124320183016108232183908654771042398228531316559685688005226571474428823317539456543881928624432662503345388199590085105211383124491861802624432195540433985722841341254409411771722156867086291742124053110620522842986199273629406208834754853645128123279609097213953775360023076765694208219943034648783348544492713539450224591334374664937701655605763384697062918725745426505879414630176639760457474311081556747091652708748125267159913793240527304613693961169892589808311906322510777928562071999459487700611801002296132304588294558440952496611158342804908643860880796440557763691857743754025896855927252514563404385217825890599553954627451385454452916761042969267970893580056234501918571489030418495767400819359973218711957496357095967825171096264752068890806407651445893132870767454169607107931692704285168093413311046353506242209810363216771910420786162184213763938194625697286781413636389620123976910465418956806197323148414224550071617215851321302030684176087215892702098879108938081045903397276547326416916845445627600759561367103584575649094430692452532085003091068783157561519847567569191284784654692558665111557913461272425336083635131342183905177154511228464455136016013513228948543271504760839307556100908786096663870612278690274831819331606701484957163004705262228238406266818448788374548131994380387613830128859885264201992286188208499588640888521352501457615396482647451025902530743172956899636499615707551855837165935367125448515089362904567736630035562457374779100987992499146967224041481601289530944015488942613783140087804311431741858071826185149051138744831358439067228949408258286021650288927228387426432786168690381960530155894459451808735197246008221529343980828254126128257157209350985382800738560472910941184006084485235377833503306861977724501886364070344973366473100602018128792886991861824418453968994777259482169137133647470453172979809245844361129618997595696240971845564020511432589591844724920942930301651488713079802102379065536525154780298059407529440513145807551537794861635879901158192019808879694967187448224156836463534326160242632934761634458163890163805123894184523973421841496889262398489648642093409816681494771155177009562669029850101513537599801272501241971119871526593747484778935488777815192931171431167444773882941064615028751327709474504763922874890662989841540259350834035142035136168819248238998027706666916342133424312054507359388616687691188185776118135771332483965209882085982391298606386822804754362408956522921410859852037330544625953261340234864689275060526893755148403298542086991221052597005628576707702567695300978970046408920009852106980295419699802138053295798159478289934443245491565327845223840551240445208226435420656313310702940722371552770504263482073984454889589248861397657079145414427653584572951329719091947694411910966797474262675590953832039169673494261360032263077428684105040061351052194413778158095005714526846009810352109249040027958050736436961021241137739717164869525493114805040126568351268829598413983222676377804500626507241731757395219796890754825199329259649801627068665658030178877405615167159731927320479376247375505855052839660294566992522173600874081212014209071041937598571721431338017425141582491824710905084715977249417049320254165239323233258851588893337097136310892571531417761978326033750109026284066415801371359356529278088456305951770081443994114674291850360748852366654744869928083230516815711602911836374147958492100860528981469547750812338896943152861021202736747049903930417035171342126923486700566627506229058636911882228903170510305406882096970875545329369434063981297696478031825451642178347347716471058423238594580183052756213910186997604305844068665712346869679456044155742100039179758348979935882751881524675930878928159243492197545387668305684668420775409821781247053354523194797398953320175988640281058825557698004397120538312459428957377696001857497335249965013509368925958021863811725906506436882127156815751021712900765992750370228283963962915973251173418586721023497317765969454283625519371556009143680329311962842546628403142444370648432390374906410811300792848955767243481200090309888457270907750873638873299642555050473812528975962934822878917619920725138309388288292510416837622758204081918933603653875284116785703720989718832986921927816629675844580174911809119663048187434155067790863948831489241504300476704527971283482211522202837062857314244107823792513645086677566622804977211397140621664116324756784216612961477109018826094677377686406176721484293894976671380122788941309026553511096118347012565197540807095384060916863936906673786627209429434264260402902158317345003727462588992622049877121178405563348492490326003508569099382392777297498413565614830788262363322368380709822346012274241379036473451735925215754757160934270935192901723954921426490691115271523338109124042812102893738488167358953934508930697715522989199698903885883275409044300321986834003470271220020159699371690650330547577095398748580670024491045504890061727189168031394528036165633941571334637222550477547460756055024108764382121688848916940371258901948490685379722244562009483819491532724502276218589169507405794983759821006604481996519360110261576947176202571702048684914616894068404140833587562118319210838005632144562018941505945780025318747471911604840677997765414830622179069330853875129298983009580277554145435058768984944179136535891620098725222049055183554603706533183176716110738009786625247488691476077664470147193074476302411660335671765564874440577990531996271632972009109449249216456030618827772947750764777446452586328919159107444252320082918209518021083700353881330983215894608680127954224752071924134648334963915094813097541433244209299930751481077919002346128122330161799429930618800533414550633932139339646861616416955220216447995417243171165744471364197733204899365074767844149929548073025856442942381787641506492878361767978677158510784235702640213388018875601989234056868423215585628508645525258377010620532224244987990625263484010774322488172558602233302076399933854152015343847725442917895130637050320444917797752370871958277976799686113626532291118629631164685159934660693460557545956063155830033697634000276685151293843638886090828376141157732003527565158745906567025439437931104838571313294490604926582363108949535090082673154497226396648088618041573977888472892174618974189721700770009862449653759012727015227634510874906948012210684952063002519011655963580552429180205586904259685261047412834518466736938580027700252965356366721619883672428226933950325930390994583168665542234654857020875504617520521853721567282679903418135520602999895366470106557900532129541336924472492212436324523042895188461779122338069674233980694887270587503389228395095135209123109258159006960395156367736067109050566299603571876423247920752836160805597697778756476767210521222327184821484446631261487584226092608875764331731023263768864822594691211032367737558122133470556805958008310127481673962019583598023967414489867276845869819376783757167936723213081586191045995058970991064686919463448038574143829629547131372173669836184558144505748676124322451519943362182916191468026091121793001864788050061351603144350076189213441602488091741051232290357179205497927970924502479940842696158818442616163780044759478212240873204124421169199805572649118243661921835714762891425805771871743688000324113008704819373962295017143090098476927237498875938639942530595331607891618810863505982444578942799346514915952884869757488025823353571677864826828051140885429732788197765736966005727700162592404301688659946862983717270595809808730901820120931003430058796552694788049809205484305467611034654748067290674399763612592434637719995843862812391985470202414880076880818848087892391591369463293113276849329777201646641727587259122354784480813433328050087758855264686119576962172239308693795757165821852416204341972383989932734803429262340722338155102209101262949249742423271698842023297303260161790575673111235465890298298313115123607606773968998153812286999642014609852579793691246016346088762321286205634215901479188632194659637483482564291616278532948239313229440231043277288768139550213348266388687453259281587854503890991561949632478855035090289390973718988003999026132015872678637873095678109625311008054489418857983565902063680699643165033912029944327726770869305240718416592070096139286401966725750087012218149733133695809600369751764951350040285926249203398111014953227533621844500744331562434532484217986108346261345897591234839970751854223281677187215956827243245910829019886390369784542622566912542747056097567984857136623679023878478161201477982939080513150258174523773529510165296934562786122241150783587755373348372764439838082000667214740034466322776918936967612878983488942094688102308427036452854504966759697318836044496702853190637396916357980928865719935397723495486787180416401415281489443785036291071517805285857583987711145474240156416477194116391354935466755593592608849200546384685403028080936417250583653368093407225310820844723570226809826951426162451204040711501448747856199922814664565893938488028643822313849852328452360667045805113679663751039248163336173274547275775636810977344539275827560597425160705468689657794530521602315939865780974801515414987097778078705357058008472376892422189750312758527140173117621279898744958406199843913365680297721208751934988504499713914285158032324823021340630312586072624541637765234505522051086318285359658520708173392709566445011404055106579055037417780393351658360904543047721422281816832539613634982525215232257690920254216409657452618066051777901592902884240599998882753691957540116954696152270401280857579766154722192925655963991820948894642657512288766330302133746367449217449351637104725732980832812726468187759356584218383594702792013663907689741738962252575782663990809792647011407580367850599381887184560094695833270775126181282015391041773950918244137561999937819240362469558235924171478702779448443108751901807414110290370706052085162975798361754251041642244867577350756338018895379263183389855955956527857227926155524494739363665533904528656215464288343162282921123290451842212532888101415884061619939195042230059898349966569463580186816717074818823215848647734386780911564660755175385552224428524049468033692299989300783900020690121517740696428573930196910500988278523053797637940257968953295112436166778910585557213381789089945453947915927374958600268237844486872037243488834616856290097850532497036933361942439802882364323553808208003875741710969289725499878566253048867033095150518452126944989251596392079421452606508516052325614861938282489838000815085351564642761700832096483117944401971780149213345335903336672376719229722069970766055482452247416927774637522135201716231722137632445699154022395494158227418930589911746931773776518735850032318014432883916374243795854695691221774098948611515564046609565094538115520921863711518684562543275047870530006998423140180169421109105925493596116719457630962328831271268328501760321771680400249657674186927113215573270049935709942324416387089242427584407651215572676037924765341808984312676941110313165951429479377670698881249643421933287404390485538222160837088907598277390184204138197811025854537088586701450623578513960109987476052535450100439353062072439709976445146790993381448994644609780957731953604938734950026860564555693224229691815630293922487606470873431166384205442489628760213650246991893040112513103835085621908060270866604873585849001704200923929789193938125116798421788115209259130435572321635660895603514383883939018953166274355609970015699780289236362349895374653428746875
+86391617809488124960608318740159275265498323596782759161693937448741870629955503137178780434084967514367416506802913025639497559552051870388547845728812610874133859341867131143305222540691470665516281930037646222263014920710489148357613800264639385823850725391990969678225562142614515891818856143468670464935446854665538274898407248669782797147190835875524343198257904828924213192423166436094091429816470043275067217690133625422738179870318314889917899468681383740126376880066807240245862277942745366001846621941044073483315458747498049491756921517996959726046905743179258284589556546378190004662030374966926777613892276603513444865261403734239127679073370984149633778514512445272009126187995659060552674497099499991189265928646916223062178638854131027720406343143645374534075679342718869937062565763416175806763506903624554633407426157646702695268599891815363810287000278474826663893249005303547133457757517437609832253279432382191687168655452097538789312997286384274170065453313034494247809778172108447537586680513365438323141236165037058337991309388747787444694302442210452520138624736570601970535466290963332219806256885615644120834521101047984047181472444172642062942912350909215924173508127936392262412694138362912034698534029602874371349686312645232853996957976163258772472985304034401810599887432335221736838719270283821174326132014143378618897543737530647766954485507101953259463412403207876080425319530269850147848238403593207706143511226987997665125478359120826534307134449329434042881949850023769389738133684830431861695463185785381153636314641651921527907513630065471177134566196342784943941683758784136080537245930816907032857330995458432708878474930245865704889101435288873790979286977089076246151229405434080353764702356956481604608591294749061106715817457735261872022340875520219757677438546033297950413253442913378312381261840320064306093429209624078106284893447313130018324126771447021965237618221531649706300589588649047354665816855013585311360083134754152394507729753906869560913454153783164553183232496559915866730081737774785879760196572433426073987987833420481720268085560040205888529950221419202006931068266703877812467275405556015147770039985743358691859456184885873339803049514638803377810038953611968069882599925536003920105830690413349486511054851281382362208659273200017333194060536134476378029495784158033549101306300166777069296528444835714262602271833606085412143030908605339936965207061740300452404886399066784416715727683825937574376122653190607830631811670742129070511968502894014955888272154858841210260228953116936794477521811516547573272399161021191869929296273598419968909634316338885851213606344211310428884266037865682896451509904477684153824057371934957871068265235573428144355686528070175063681402613833189778005057437359709375318197838949838474184672784242028595321701572448959915657988186638015280501953133315692590089769572353129496237832301867518335222933547667689916438863487286929436939765986961368381159054807275234877196870547093178752561812529838144811693171402880460849631575464022329195973574440958072657230603702038852456114852567350637252192188739854859055490172316463142654863087677482632594349356367426241455488330506865993778315054522396406104921602936133550061252024956556234835030993188819156767534874300225847133237663479548702410522940765043534088621497103337262078590010579548147363232752891706169013713473842118751363928717634834490897128262097154784117008147460954184074337943389949991358075647787920432117440928862549642418537745097224828362958917927526326932054091380935051870102627562454057887229338190092427755509705760667196302471417644534221609511146848351280732791697294750306416829242854882595278515971071555101941785825346938092293010694329968559988024833272005004779230087804497110957963594115974750243730708007632862480749798043719266772897381217593503430439873983918165168261839640694502091824578525689274811807319406894273775319394389133180915242646080117455988358970096539112307455728700473522500852134296990104059526628563607590236571773718087304699511462943566781622840893405003748470582759114000971955318470495069619282307604695834239149482009998684352653464770530351484138783900107105879104944040066134553579001701204669513582259935226942467624082085360525607628273346754479067347096685944444884764939352504754336914864412681923247591722941982198858453434466090696180747006702709063466104567114203631009310863271280622648177254659027414937523366742067515636843302953138299913974157602360662851153005113792688178623896037486033726440697972770292634848265410746527459383931198680817545485498942469612819309522677193170219735983367749469945087051737683897680106474061563189164254822181079055751818024600344632142045136481348197353754103074504200251441745223957646125971680361956403470279083044732203501839798367696489434312276262178552717014254283315698522941126463745931097569624660352390612648093496467354108241738261083596712150550578478606995390804104011722834769872831897068708573191320670423931588646375200914988178240229516317088683298891479658240748014570873772849012760702113640079639799182210249085149700525324629324132747002079578102438578402171666793394590554455943340534487707963771188610498523187755045799644586167684088056107171970597882575881256163531876806117774379599004773623712811869089617251943939369330585160382125801953458370847795742417368643297511477520679725269418131643610223375709669505773571004996235783457301360941580161314660369715584780305217772742722143948123041635001121516195567806875993358177860898835933212092035701710563825067855180566913493796759814673212193104828134147908779554743466524184190135327403035785470472280891868531158703651246356545710611980416977241381573826864163959201427858427235545429757452025357266037154051532937658298050264342134989935801353842434458192796384339037205054300480389128627046694578583909218742172850735600804441819501137887585645123698620572054452389316937664495214096644842105411526548610487510957754126925831595832143034565470225511124731881255534338004632006069640190015122034757048299518242312531191581328142191448345438130389978209071710993949488896728286690341137363026202313621323614096465717418351085302380547260165251808708143637381182568878367961672764429978462802943968574302226134572909943397046768372792613699401327899659281405612554347170474539407279074520803480443363454095715850796149288331608502522373998887499093369824786970028409289815755045330491637973895369994296399826632932922589564886072067190505817419587024164068923768106081827603263857989804374735186257788523473239936171608865782604717322567888235412369561667469163580673255215257568015075052632636146329059661156264244675785882758738660961344319890619120833753656525652236977906323815830932586059557698757515918455062863750413704348013156521641516052104281364743090760249429509273045871069747982051917325443758192819302168715289796654069062273032958278466717617569783045329127551936424201370279134038729674285823111922409258250651879292838216830669503185162359201649936990829343163509593096427072341448323883539249596057729788396903779090877461840118485036038333605645958130102860543951487754249671669571496690450527460538572583022416163264211557452282846202040938845592409130513717077010291900185753830922380999867084182983960117775992932734641627150864920451453110889060423935530013431758924430974801368883507407757734145305725526211556254721466467720066857198081651671897453523527082665511960940285725794247067819163081369797295928154121430723748431786824576850355580219408094553821054272893848435163185967853476191166193207812939193543063324740578994914555860972993152031624503548872267845726845229140212757127116930849052462836684634746410884505229948921572900587351985971148768521387323307715884776511738234870389960977578920613975789781225099235576053861424136270347279250433104816389503732898259497802519258652515327490730782833374498318687986723563160254370603914870966658385553974563323993843754925717811317650307025316767064088105013892267609210664264102048091859071991363691749013517953191631211836750422764925387759521255073706315022304727260799730368073971980805776485675285617940492390140347635257323698331040190269629640803921296656373645021385416897672101946112782619250702262152593124541358276161125609529438155113304952468789927780106745839228568042774043309735542757297022420487487412934381740044927674895120675623610636094588819104848472980851012770245457449547105931997368379754754249811005018212193607219183676492971103046904019978489872006356766718894073817790589202183486710334386437685630938282994402396882348193338284985573170804840950878733138434762916485983722923778124109961303860169481917122305765475600012349248552543396504343070018140560441117993586961385988910598034680118346525383596024355134963731232826135142835093190584617176214557276231597250049511726475424606921101085814676642355433314606078996686202964124847202650630282340459157883077000079251859608694062107577123768032410768704558568699320449681797237866666362504915746487299837753573633333307424072583319986851848451747001953861888352699974337386718868354962343130198505766758238703835244190630885623572628181233509202019272239780343219223080086811027188764191013922997719111274999491717060899332480794825713505840499425744694266776156689091208200208990745323381810321645601675622169119144023828191662132205057502642635719735244931629835921407760500162258419905430043371822324200863508469775480051358328398178661214045843796681021496878853973705349517148323100017258338582158437845409675183954418359796556743537426151990806370776525789830696288164239693235522373006704988120864434596911509571529525370282659877711418022459564559994565063563834190133915479546312863069624136765258038957544028259810448156487022412129168535659228897129465021586684239410674329099840167575036065595774849125473354628817341189814574265759740215386613087429353905500124361361322220921947318044014731939666033637066767458880118219445907334660441128381728281695021648882817271376035759418306398933568069827507754844686088469254046015467222194986727515953378357283936608214829673145198377171650957070150209430133636532052729616649044102572638857291121598554183984206320166161460078461529430639847604795291614364391218795794922085516152324246861788850797169961813397435956352747379220060342189342732061559785266155219926851262102840082200317621475316637888807194798090946090591502515033627036291948287835349814637570305594337014452339023583504914225477035062968226098968863495169877999363138372390120835058285967083402452384844154093756808456553500446874483013564411249354853939423315579783799494092835668094604141550836817978779517181321408759292765945454813790461591508325117389486089416838442380771542719215926962901856914292495167676153237388732500001566631961681934676063082207198291326207441260346105650461337313505112555838887617386073837160224092775990276096675031874833117914551786672284151020824869882531367187959364701522911663884566846577874796370150183823195607359435505813900164991783896162374627309014541595965943953217137402465255848473521497481977820540488058199139641887855382243570119750397818407332510434328400202057164284811017319978923050293812811910397180085124911249178363735339373814627400390210015195068750531099401352316803369272064771307342700308915060931268713556060632764342152245638626069119506824589668935282720250472299241933584792052734124507376559721479332875647607780091933086818674969611351436845417276514659597737148207256750432258477391722370498763763057852364880856562758103601091188786991975525576291759136121421047240359842415411786964339415720777418732786755530587835970842498225826968515671718852019511342896378666891591817872324493883685509919175808998323852152675446485340020050826485415270204743326768268613659254922073531087252460474396657944022129960915736177299626458124285063893345047291798282725476047247559760123037079952797316830439814793881405817872695451661570634794251432213580319770750488568812569807783281984904668252068263042281466759744246869429557328155125830569322604815029795215691792034811754048953767416928956616208062670414531766146162325295091795030436121112184455920859047115429459834797046585340655086770779821076464234173051386828497539566205627936823417555997467085412145582243327695153132650584350781243765164179963353530207305736622795491922911753872629430852200734301710075765493712488215504773481019118863882168343748485515261091545040755531225789080122313853784005777502412904191707760611518013799039662977695839632557956151233227793943969210404736958779651380732333898035362260865401701111988965595174995535074536658389688554746305219206866240745479095525342282556770193441577105841489903640125077864158255529366387431270128328492308978725083072902191534221777462145762834828430678649503119786637325533317072193260807986462985094778294837981682302008399491930570495083987476235676038760272327997801840300430566304352085149732957331258801828586285820579004187990984259669844351147109556599322347861361245793137866151512179920126739698094104741077233687321525822298530292904960115573398233314505567167687818385961670457305640333207364966296676971338504155009944656854175026777107065705465957143991643827558497781082826807112069765096872035523854153209461885363043511221966680320915240137655091749983746837474061145179767515183936982311577948284419164041918375234460325537453546882218388816096336476688397568593335416943201534848672493506560071387171088058309675454603060477314219421889075765739053581357964188126104897817648628673044000898467546023669615427624851377967815770398303280936467582126894692196063822308148430350394894208911723397170595973108875564915459358749992760296739342174349538228888430989341053455429250668307235842231136382485518388805776889053504085352206145593152926741505497606094351694402400010103533411685610651050209061138052252838975725467824630424933553579864260239445730683061085100988809753488220053820587522722080820431248991556582008452560809442636954053017779689009350075183099128827930091730880995063726815435986408935574184481565728709745571816004522633145399709356222472451863925601433945582980875162564019023663606623281537624406459938073226263634783836530973675033498974803916096419620717487333415062806913833932251096335784624709063141072836864676054363906444092052842257085800574527587928663692065543899307757920938015819507912567629991978406040520226353210077911238747898581551874233928623907179520206526562670037616601659171905262500220561942089641956465590938150908643056934644900740872995612639959966200801287299316731154844822520263369098395851996235844173197906509067985945936452025905667368290181252665579744207456322482835128987895444836948952665706289458444206330096535500793500146160570659637650227441755967405489001968051277018819543074129614200263633421720891381754180192634547350681359209926140734853769512367297013339906319383527998241848826891775279343584940075385897743491166044563829096432179953136691170353123579706823248915543252913351173629922527896847750580839004177431959526449935501165967143024532625989940650715995888531526665342929281216650398790195762648503497651821155408516672071854577917807473113566188980576062140418053097864056803517356309514002768002269382638045770115816442203802894363681730187129077037011832837031169175822942608989513311234164426659907151224688888274493590667969962807705665491267073066772192712201301459930896565654015404561468477883906612346758724544094063531497921166418786881377572404906798474889972359185952559287216146129753580251542245903385750680311710796307697697538553858862595693680775757796664663533664152520890270366618887905705858104693577416117729341183017892035877581208208737375977718056375988783455813704348533774729310546692908997740348121354970856695072478096575302683157924751536198974477905572794037229573092915778567383641396674498815613659950868325375903192592166095550609850321976761856140590690371310509087753580264641477226616292369481441022294937885620436349248291103448686160279894444591096874238973605355031125972071388534061573700678349164125819522945814409140362241632753610994463811882591985121535304658980936675244992697756417094598990904682499034292192392582125202555250730891817272048404347264534186891188409594490919717211163697254056079049740357338850225440113211098228763386019316909010561474222252270919468162276292743387855651992083483256084963207692130629707604850046830943694269695141881658092273055885425354024011681318523407407307992479721279263869896207728467749628951800026079038674213822265436200441140857099926596675765309998829599029231138959761336550418913454236179858870121164635641962071745868774738148225087667400971365155407499417008731817753408115952121654435121541157113781812012506404456875249272001277751108003323732202289736119350461448798242288590380058101216891487325633349957121561087225771584016267704228131390448296879740957382217399146002369049908783530275660793849485128969007185782515488395547513342169181736368536095337750162712522377454474668927357796506881957490741693200438009176467025512888487749625522071704147885289075694417513969809222071410250466608398099456715891638652718165196711062818269933641527315900616126740005341222381595344307775037803829567640701650992076074859218751751684808661099563191668439562162545519709015309777173238031916239791600643636555279068195294482165728173457192921319183996026702735881594333444284421226182781271826185527370325940168008224555990070053975421133955335162605090389294722018930734405134003200204336947910002952860106529001823124185637699084489820717600637338649495287191872158754457047471907986293010473144946554743803722340641390514554629402142302069003104741355273681013346850415149232076538182243921553026695966033885734660418494158120078629809109615960567914563798717307257629688318546194033642271024899535605542286613944718308754356430019523073633166617946447191292827177384344405475614816917585727115061244152934316911728694982312262434796256220196448846861051071569998624122745958813731732644765452681732432825381069952626548495349480095369410951481996617355631640220284127277763673456992174737123675034539306475653320230908568827165652343651336244570190738775477531957003150588842184233376355404217887556820059729051736783895670685221520216425045144861739795741334241527191579169553319045580890827309448299383194395331280904943089572350832276300293065054870457084460870206861822138320737455403257091512618492111114974468103680007187934556632298405027684684747548227130776891701537582802512555409970177049701830592973970528330784225285303150289166688497622714281956527148316445176806069106769472868705559264007756107137171620680187393298363751290534235146115308046062098169336930774997155366867317670467185549256406586019861053574424688894977696788768691547092638006149899573635162724633575330938004487634031318038192923018836426382701854059909964764525599601783033017724399119463921891489062259250359598507798778312405447160298489240983422030664931918695842209470239177329476910225077955983722140096730615990361423790937247681255065361604562100483933572656679052241169296198744666516331070472800093424137134612249848888939436828636908088488502015131969918723213716743515481812928179172413845161345687603736073673257587216657287676371494525521517796019409307250180387813212225769513540004638009613901731137635897505726043945870793194802709580503104489636608907745312078456164790778807584763560717280681183999102653581080469732241003256659566662000644111650456659227304263651233010498036666712610244224490922994871983998680827073201848451323596952856430131643046222369365113989817445964538728193721487060600774186344731462361234662207731440083802551216054319559628127833531820714362007318755636050038330421611669150702795475685985199257198553662521148971995942417612723964590612796122991297677558622748938045205099223662030565159427055742817182265874992584625083048148395649776239129625422899275514297106041186726653498946182121569919246519669133290588920604931218043727146020190425141957535111803793466461807226919542343148130738717850633273179516391442796645628196262045437343732237813727380802808864168462246911351906971734620470833845053142706889956273442946947086863972333940861128541888396761914409718582767510277489001761922176147932370041281323408212550832005698591542371940420830874789555739566522721035377279840129499810198812734613439724111633208517809299978962377782050000783318678719955175367117518741108968566039911424204954799658914478891688888887902416711759321819119274683684363511136639141279248816957812834560113980491157454717394002086468212111392452193789957348301211277854503693545894139376492526113088611818450136571153964970796078844869644321162119739290669418575353887865180250938853040065134520895660848154034832821415034666023895388705537612629361124447253239627770041368213722542162682661908996350463032195542772486974155941713913064531792715034765509837831840504775004918046276255077455476645087664032394117501671426065979352911963475883648860967289322802901431167208183198299624606685536854661942866758318427963714770747300224668687185932067890029701988910742665054949274721649340029965090762787616021673707650790227068199470173376734791617102322799228400825782637142282713017845028958178877301159719017325028680708434169703531285646267835917529670178689017217475801902948424261911766854130757738321393089078604278644967290599488961983424727469595655858035242892924061661516354611223639479292304047787132919250656397877904350105111406925577154144821529613561635406345229202566107699613245129589803347226092397155037514601931714657177073200844694144773367472165221014324638916332647957224792799242527081940401880206594679660377980567894008963860019162900691783294823945281493194544110137765576473346037659512978197353022688932034686109720452275882452792021164589064252703368944143300654074516229717703238105917527366151688210689969340931510117553619664142155718499138433937673559758664725537940047900456040747459655022128152758738888998585439382594640617829729709906538966176421297061948422336032656603115913916502538530806539977680579643705936526787510100536774926544010980317455475588587567473539479687364553711721759306152498235126743584675828922814203168102661043995673196489261782052539719890422936308203388710062973854110619597927600115999155260060057506167532492827036417615053562191567193440355059828764310589785588941377161879969769254803939686820690316359711942142416854811900845137229955791223302054344979902991074995882899388608128240821256484715102404125073673680702797027437864223650331983285626563097292464710420506829052700690992087840073668033114525263929444515466926235325557676366353086279508584469346521383616765675214539157854189272101657179690583489367982763027001655527807862430310606309524346846447591247701441511128171647769439049318318255936741580675371390662085379651193936585420963026858563609860180929864357324661788962358134544060900224067489464784626738433768952477207116615758604977891974264196667486475523677347998380057492852492022166864542083214517267780709578013121467203100897539704071959337050146009143488195520622511925422622143225005741526829852638093416536815205083353699473215307036669522783298429669600164899239773114944464830872124667977814242926953856340029185888134096530845313520911457647391868573115136524405832962275741682620356099739091284680490204849191160260700758937560354400380102629408120608211165674505426971955600215434692911020847002876530495840035219773287016838172275335604138455890203371838896676021578789752387614791032623365218615942732728798224674813745455249260080680296169276663816097584682397446535989552095023914755547684084500213257939433721136577128130619593176397089311888507032610264031324194552085423430743172952875387431511051225201623598629998855398647236864705045471473761566438220787838015350032099154116117242326133544713102237240701331156984204367679552250701589358266961116203044229512352348726668188086630759402689822915601573571071728953439461212642969467192168261046145423661876022087042255954995186550080278980932099736519179888112483721466570118199016274168544759913402173528601967815862226349056308598873061470704607436853889519920518266511348803244961980584123841215349054364404715194431058644377143805842840337066715290618589020323559084005341566213484319233035958316112590359563170876965978262092158227231031166826881939493863773207392937017402697592225018983070955896580711464283823811593823825061262531756702527915910654611144812096200820952969368580944923981187105150909433755993586987307207209555173893837158436170650759282157861234814711397056122509338299425048859494774668710465358314398100920364440110910934351529933131023905062933071424241492175720027768655935545397557208258739890273936680812220853907531936472261799890311956163945186008623016934167954392087756273815330371976212806458086137697216790592015943055993310879567191475647092066182100446455688339701252538322258328395741517956269734015529240124561242940489653221263065661010972343323232257746310009605299305415047777916700658340638778022362350826141835206349979008771079856537852294691640998466979646696038038811363617686189311440973710895810983169371596171098288867559180703859730811442684471682250482661321935624684066852134527316840990898691875270317946817084870603460098341255711675344061633801241415400628233359610197829672875291452991479474308905414039537121244443365596341695567425873370791366134585384444800191212678381466711726559689048780765193677057678376614020836019635265839321931481319096211192144686706818422310064172560653927237945810709200044521231246078547777095562379159802059745859096840990292033038007708622162885107186000447756400478492890957143575978364274378473595098634821793224318045250297952996370145073255657312702497799848789291843294798455669350105228602395215074400866797688907938182915929102026826574633914199314363614260403317843549901625056698545968009379026007135161387782536009105071672759702329182190865546807006334707775010938749752013853092082006394305491802524508729914736696086410186182409590988054428760009946433724388127356470618198532427942973434863605893931433086444008868527675245162410975054336835641751460751711181621941738237149631522263312192071653803243322926739170518302989359866028413688577615201821360685560970590055738438451813264270953817965721509244485904462567802865009498077190212704137360720233072245994561876633455254770483569760173520071771942521169001020085026852453914921156320915551401348779457438306251837853048193112986523190798482256419796872820162100148332294661140934771911261638316817306820603568111770448276551591801827689473230259044465380515980907386856806319179258960122378037964041378385077814467687142356538994566370211784170818262554138206386887579983532407785367002212632708390716327946350720046384794608870368796050959555721823765875250639988220237030955744825693670464384169947974470184227698439880480330627192276636154129643929829010652489464527746583239462135792039896869227478071572461123828257152441213103270205999701372380053289510146535803438964377145571224407411100712669427025442520473228618846847510209247878012043406122305812561699203097751638922988074721196746483766946097179121483886490966539513807374129767123935996174925404413998971662760595951359596375637064053400172830551589877541654375992913260090936755709143107433753105882893851431880662254239813960958698087855574588809335798621457738009043424441015517393069231026914564186921976040401600119075692555376867445421249017966729948467002453189991968372448026897464462718163142168645227183123252303379626650134219983226448869803697978590522429182061106882129321647999144608678150197445650874223081217250411553556621751595820945057809690280214927369803997087767616810712390493358095719453832621031646604474981810547960006178608178899750707655446480256230795896536428237160171648195456545668454337774276560868749822964442766300621015540830164341438338438225995540401620108165713725404236588241609965476268328280899656131062161460281153982306499375745640638144971406282779348932865376579198297604581948861594446114221347493188749171296745899421179957807630290719889524234733831910023823443554458261601065553281499317776535173821664016652366210610884637021546959556874325389358779391454645798055141088185843553135075720575377323235398467373167604899270769112503993232393790778747063477696717505816928534111471953238096523058569577559634184585294841271978336667224845282727285899747353253350830654767667074597564685755666745336924262430296539460916326295636994310000682600237436985776866029736393178421541401711830631527343317342201407561028772532833772983523657614678769458922694737230578522069646923492970584620363649983538137038367166115455421449742852486364421312750873894118200324833415827702820659205753993350094142325974729452541658469659400245581547070624371610960810571475553953439295742791935283391632289391851751720640320940962851703997766632450281559585197338143547102808016431311138599733804579086988417052760571753209911006113770592555880621407184342206769024469860544041439986001080208435860567111960746709433190524473871257313528691915097111525074370527761195523277746882205259773238949535201874134912655405762268866977571880510070422092369083152758701780798727702427070791290084969169186759791666237623310983254362046836343173629913617890513689587898237582285027323923764436207136447600522079632632984338285429444520261989197013425721809710853274870815998583389076965340733212010994915903001331616197959954481743523762723519923890767016825374843754252662493756025336923415861500676816782128364013361639559129981258295831305657693430231547206243831660553069105008790177286540113521078416487701623591555484766511311435033911362916128856324824384399710948469669964851816138672384830761272318164126842443334425790345904772856470953070303769279946921667065377609710149983767130849080143591308986680247304134511101721215141668015925336023407653895540325570816353348581069207957254657277829830378809008803256739084098636848250813710130161459596158758089961694518241070882308569410618218264221245267280982064617280201160765856114281135611571815224536611584320617961642521861357263621921107371010769300194302439596282518730231526033034930575952585493071677328671174804978528057647190746725820152493185070526240051933677648014743832641440274502887921797860623539224384602609063644330757804122799273877852247381258648718601339379736770225468581060113452620313054119216892079482832729555514429540214536708158456783475118558098862533961270706962151603657777875136944545158092967368911042058592178671070714502351375587110786086658533530633558079153426891646160254946663655457965105467812707892552126650556129573547836696659497590753062266333477728939768299466575355230537459776810331331160241382234944281672214161214424647484193059351908460507023322555586172901656591875054331943027841514117967343947748871410719335697799863808317563698628607308253706052403380405140789040772315627250184458794440402711657896688238191331438478578414877746647407060376456620018848764394143877769435494189441974579121839190318915362334959374249767494200155788230849252868546965400544513380361199067171549892498783210616687219843774427521724327963702571980256492170755390227449233918500494585054987089516247392993432150889198200381782814403271431170925677409514331290615968943736603875624049852585356166180114922582145395825332958109483930170500856598389732551911557687193598803145988159888078376701166758564149652356826377840419093045811266163744870066666224180506469587118808695058263490374836411157903873377639097620214808164215338083869661092386528488089931745939443178542356757566424676408282723683254366240644309981516354725066550444143000207401603122837341117099904525688157402451239486349296944267643967561682713755456524067383016245213492839356335176511493611596557522533095463115188452529829843422712978092461672084541889794591695439977776693443491008897071973966140333444081967268961968845681656079579907252183214319745985747675121376168508974961819239115727730828723992602274783557243979323536896390406465868643457007472165970967145644987186955239230882840874725168573235503612559755251070841934785165149065264182632491492843988407067539987068067879327954661976766635244079415404887006065088482803270654049969988247570907753508027244041377685005096273474155986165808626742208198410687696554558399751075890535037088686062493271342472431449343376247130707073213546237332081187091809353759305327934530063339674898284686751083027484727907372549768184980698806497521442529263316283992174264087452072046691920267855102202320709567126162295188040787173438870226332554974092183449479538450925005769250822114889873106724339994671856586347717931733386023348483494103031547045940320844732611809857277359033762554413800731952126257761960629461695267877073838628733000434941658753669104444625859254841732797978134013857080348028235857514929619342233225111125775913404506222277644337050643209247682137012221060563915742214373755158839482296904823957582488775558060484558623716729345810780846331679207444497809769460950144063930392231688582643713481412725686623479129844553733462329364672572184779930699162053656929858859403870060203388840671662403107190079760051328295541456145724615168756919459873892574147576272843005275040492894360954149293884353287490244715833817011373206738973136373607859925942259081074525144248580786687513199026914658311236376970889528643032179439303436860121986573873979920396482082593360782591341308548275314836709631468177469721884723057657233927108627737116775966164774465973027449755695357444287555359404381594756073345514798055956810027847927462763477840239273815059331739599435497770590448953826540475199259024855566858177727516719261947776394509262274914498556843621279619475681289330176312318997965657756048803963845992084017451958116442288681720482496850129661679909343435471608028380555654460040988871132394375971855251566533797354146837875167239510249731887872836475506360990258217589707503326740817631201552332719427777506072401392106001157710559783863234349416285903156175047845469531621838436699404233262593522503262828587261780945357124195006891207788407245637969551577590148125609007670161949526711754903022436298527198586267321934654280038925723406389573273490499360149093300653356506402015117359851842829116301475575273093800344435119537482307204005823592461801847947945098939361458343689169422254693951203894919934952530689463276558849442725360335832234476004061435248699252446652391967359491750868287604232604245212321058379983079866972443688457733417690463530311429385430110241585593385713882119129412952610508558263931354089221872473359113225826651573714324215686938751879245423144505040526680333383337452802368529138876098246682998842950932350697632474267049196979289695416628830901797446351849079195431576553123710635438449974564199564923702734037161851818097997030547121492333382757519685845712145672325437613350289133890761950397281335364079107519335370350360004528433413777606681157520696245826642703259542986650338014745243515933085439345782199715933077494965128062939833220837478948635265801041201431146949831741025185571011421047572561898905830473128681070386735624407328057016111062651917265444200751818642197632217316336452859242893857048467171496535871921759589420891319938688204998542389052432569464477965981795626798453209155753050282143573757875422839756525978740067558878394173184554739980816116066968874836670028017885332135718624025978707925350222280817736085498132275532355885931587048100376511426872476327757101181976957689361000211337954124234078819627262227689040700746648698443820673041743818969244994195633022969907173117411014544459476753907157577451757815276171900365962044313789626675278303256899390875390386911627550005882799501728994333419948352573935798314244406789475314481357364275535807006399572364519059206157894335611585373120347089886547070268301680900288364999157603642498491130225241279942583271550323686378668740835331545831788609511513039521147272325433500095425257937574726314991736193877226152268195712702576964464788729845192402641178184197277886804636312626729313901118619524433017311035160005904185949963081064927855322036769528181978317786975091837893619394545480241578952793710856230054149256415615175866032857294169731508325588039162766608197407466065176252565060447509660689172826888366607344417833678526668032496153189365826536895327650361432430074634615159337696525001175767596942430237056672630297135050358763785053439188040350980418983606119692641825809142184284616427505896911075688516470740380877368527749098261704336309093910171041268578640776671098048829360361491581284543814229559429788436544932509367251057096832839589204849525017604667789392562525467768317743144920259177057020939910289857468304265616362504947345088615010364968061291928440302430179753054988686841035358368188537802036697140978480742969657515130065724520378551329310230768198421399152657990615611604691111577947462305649338901179326679898236606336282504803183385676292513423692305033210580816366039506539903319384081005409866846222375982270991317102972309039487189007497821283853610045261816964212323839629054358563725825636071724276847374335256030003348880782066786098059772800677229279046038165622824985149468947422891191667419757433645595421174451209988075069272227927738865351976480540183803462799415234897368408457856962008023747142833147938215570117348637883652118705965892208482173230002058682459939995585311282065703913650192130551708595178122805644607329156966061723545013872079514010885633868046309431488420132801122195852898749517008906336660989846442315150865379401132209602687697083055405663367163718725569607937737054014085142553783468470311313144129875045804895664687083994346815059871380353772700651997153332303007065771967415055249904307575402247319335874046704600756398685355400831780107818516460419788736486291710087310967926279737374644809406277184419038922117985716054886712993720732651399270075029656227713050572478869909194073657529871399063634647836366865194016304718191207983132257662461751361540819964894203961353691857951795873740131728839970617442333813412051072483146544004001739160390961618633802297146194509614685941537992544041518038576858263207240988327066671838554736465798941176238669397690291037697920775113424288082931872326519757177726248359701296275945305648114799639517079130616743895352046644378745762035553600985041191336031036397201195422259903101869479746838421964586157949973271545423156796709394492013994530178371135773250103828243038538185705933992851370812760079244339404109004215318993466717684643674263381888613160390929621938447531118853568836639921038838510253271679878330321727672270233600952467189715078524918476466896128902761800889137239907194692946355196166076728075903050153600668708244332649882915323507584710638911477554386389706280031160039809129461540904980192551167965979150055003799732896977773655190282273864288229990724003821255413610649004114529848239712345842480504795993715591076737834590163592374938300356322419570083288574136749580642074977191759526702556482000310308458210303969957743388036368287799814829067525720445626377245659652703388016088177577856155094795329034879144453600834908062146074088490852755810560731613442779645262194634025618841486208878335280500603481881697829007878925052389265568200155282119704086107558576771153896139053641413799388107790701448595967426377503521955544414630480431507842537832584126706637536330748345915044813713967388684508172111514119020828031809427090743556031490938799810208789780836935539096404634141953719723021957316234996825734606641764506101313222789217754928201742729116505234331181790859575883923683750385290996377817505205432368249937753274248467555543819518745972578794991730984766142562404643240869622507178371939397898842975082664631187302399703567746190001151316316328477032739770108627881996826593040166075176690635271785780737196027379681264512336929563288462870362942894011000685999245588217697838831585285715301532420283130654446876388566580623439682552981527366442051390153955855141810366808720557104389674019177384141585431011506327801780255186173129507543136661694285972899881670304086336378640678461338455032562687194966653649060880113636162254014929268068122689525897129776403426266956682169582880086329042181756074894764200436136615467663074570438293136133972596684593926263786444679852812644513902093145453361130501365088360571366020444755919792270964290237658657822242920280879171406861830214699686346613766368868572917316841520295864333402673713007976334337277697006727467084983278668798349357366440843500267090909695735924097468274175722250607752469388568947850027702936003935201052040873128479910669503625324409363666859389682289002963885799014997859740569778960972695823381292902537645512704464258526464055214677552213580923641806040893329653662479504291416887422237000481966411563609136165836422562138578831833902395187283779921305958852781330259146127861402073820696214977203150988949696060301845383332778198707871696229973321818775180833760767681160832234295216786089372600076337048753679654964802801275864972738154422126854415152451380529340386177510534818303828621698503184016166795127231878553707229457620574022274796195552822698060233348079379943721284230894826383511034058743723370805008519719937159581444190408573620434202939536513248138997225787695156477528276980706939663940107722488182935325501554442342959162848531656012402297846716680117245335729329673101712447814484117346342835884052910754989382096219714472424413055914512220105634688443505317675418804492486262358256093411230501495229935926061492467940926480910744658298906805968086325370260070149917783387033551897345974534355968226490642290139992796096559631067683585565483124248108070411241864496288278775013367814234676106615790155892833100345673846243104676900000936756893803676769777642059716492347060997973282994459039755683869105685411058885051979862321618071659608643166523833695792515458773247974295235724915183100135059940954313672345441853967639642257048786844333673556851153585056517249014177233301807239035068983866253233826620354847687722321662223383305226882245421258277211223435986491973881404168406609216954760818955479619408040043497601356464084611480778855378911228881396187039079060331474168814336581362769420066445056796904807027922065208551224508683937565519686130523209213804180827319885292805824696457556180161852004664494926234186485934292896521378574554544426221453176445385228867960454072522804961741905198550911362542849130027243353553345377968558497801959766365162905984572190434898213582212068569241211393131371321348657414408926700036655556324464997755685351468128988739170090705797083912419192306257054777274861099092451916822532682357814072123818963141147129610287340041050015549547086272721534936510345705849389706515725684266079756708385889612130516276472992631596744745949011999508491789521497159877319531917595916234240217185796967781020544965987668461439596506473322198532352137810818703064287550695189034358718163360412639767502090913354848015113595182411243263608049744737395896608759569909256138919905403404664655310556021101996525724843421071082933739200159651403373870955680756568226835379339839824880227237703197854614809323023472557966211738929885417307414847072116640441570575360458225614322429985978068323969654385552378378141386675079286837205802043347225419033684684301719893411568996526838242546875
diff --git a/tests/Core/benchmark/test001.jvc b/tests/Core/benchmark/test001.jvc
new file mode 100644
index 0000000000..20a7770821
--- /dev/null
+++ b/tests/Core/benchmark/test001.jvc
@@ -0,0 +1,13 @@
+-- tail recursion
+
+def sum' := \x \acc if x = 0 then acc else sum' (x - 1) (x + acc);
+def sum := \x sum' x 0;
+
+def writeLn := \x write x >> write "\n";
+
+writeLn (sum 10000) >>
+writeLn (sum 100000) >>
+writeLn (sum 1000000) >>
+writeLn (sum 10000000) >>
+writeLn (sum 100000000) >>
+writeLn (sum 1000000000)
diff --git a/tests/Core/benchmark/test002.jvc b/tests/Core/benchmark/test002.jvc
new file mode 100644
index 0000000000..cc5ad43374
--- /dev/null
+++ b/tests/Core/benchmark/test002.jvc
@@ -0,0 +1,13 @@
+-- tail recursion: compute n-th Fibonacci number in O(n)
+
+def fib' := \n \x \y if n = 0 then x else fib' (n - 1) y (x + y);
+def fib := \n fib' n 0 1;
+
+def writeLn := \x write x >> write "\n";
+
+writeLn (fib 10) >>
+writeLn (fib 100) >>
+writeLn (fib 1000) >>
+writeLn (fib 10000) >>
+writeLn (fib 100000) >>
+writeLn (fib 1000000)
diff --git a/tests/Core/positive/out/test009.out b/tests/Core/positive/out/test009.out
new file mode 100644
index 0000000000..95cdc01c0c
--- /dev/null
+++ b/tests/Core/positive/out/test009.out
@@ -0,0 +1,3 @@
+50005000
+5000050000
+500000500000
diff --git a/tests/Core/positive/out/test010.out b/tests/Core/positive/out/test010.out
new file mode 100644
index 0000000000..425151f3a4
--- /dev/null
+++ b/tests/Core/positive/out/test010.out
@@ -0,0 +1 @@
+40
diff --git a/tests/Core/positive/out/test011.out b/tests/Core/positive/out/test011.out
new file mode 100644
index 0000000000..a6561c95bc
--- /dev/null
+++ b/tests/Core/positive/out/test011.out
@@ -0,0 +1,3 @@
+55
+354224848179261915075
+43466557686937456435688527675040625802564660517371780402481729089536555417949051890403879840079255169295922593080322634775209689623239873322471161642996440906533187938298969649928516003704476137795166849228875
diff --git a/tests/Core/positive/test009.jvc b/tests/Core/positive/test009.jvc
new file mode 100644
index 0000000000..fa5e1e5bc2
--- /dev/null
+++ b/tests/Core/positive/test009.jvc
@@ -0,0 +1,28 @@
+-- tail recursion
+
+def sum' := \x \acc if x = 0 then acc else sum' (x - 1) (x + acc);
+def sum := \x sum' x 0;
+
+{-
+
+def sum := \x0 loop (x := x0) (acc := 0) {
+  if x = 0 then acc else next (x - 1) (x + acc)
+};
+
+def sum := loop x (acc := 0) {
+  if x = 0 then acc else next (x - 1) (x + acc)
+};
+
+def sum :=
+  let rec next := \x \acc
+    if x = 0 then acc else next (x - 1) (x + acc)
+  in
+  \x next x 0
+
+-}
+
+def writeLn := \x write x >> write "\n";
+
+writeLn (sum 10000) >>
+writeLn (sum 100000) >>
+writeLn (sum 1000000)
diff --git a/tests/Core/positive/test010.jvc b/tests/Core/positive/test010.jvc
new file mode 100644
index 0000000000..006b711984
--- /dev/null
+++ b/tests/Core/positive/test010.jvc
@@ -0,0 +1,8 @@
+-- let
+
+let x := 1 in
+let x := x + let x := 2 in x in
+let x := x * x in
+let y := x + 2 in
+let z := x + y in
+x + y + z
diff --git a/tests/Core/positive/test011.jvc b/tests/Core/positive/test011.jvc
new file mode 100644
index 0000000000..94db5f86e1
--- /dev/null
+++ b/tests/Core/positive/test011.jvc
@@ -0,0 +1,24 @@
+-- tail recursion: compute n-th Fibonacci number in O(n)
+
+def fib' := \n \x \y if n = 0 then x else fib' (n - 1) y (x + y);
+def fib := \n fib' n 0 1;
+
+{-
+
+def fib := loop n (x := 0) (y := 1) {
+  if n = 0 then x else next (n - 1) y (x + y)
+};
+
+def fib :=
+  let rec next := \n \x \y
+    if n = 0 then x else next (n - 1) y (x + y)
+  in
+  \n next n 0 1
+
+-}
+
+def writeLn := \x write x >> write "\n";
+
+writeLn (fib 10) >>
+writeLn (fib 100) >>
+writeLn (fib 1000)

From c5f09daf0ef37df5b5101646c3745e3f9376daf2 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Tue, 16 Aug 2022 19:20:52 +0200
Subject: [PATCH 58/85] modulo

---
 src/Juvix/Compiler/Core/Evaluator.hs                 |  4 ++++
 src/Juvix/Compiler/Core/Language/Builtins.hs         |  2 ++
 src/Juvix/Compiler/Core/Translation/FromSource.hs    | 12 ++++++++++++
 .../Compiler/Core/Translation/FromSource/Lexer.hs    |  4 ++++
 src/Juvix/Extra/Strings.hs                           |  3 +++
 tests/Core/positive/test011.jvc                      |  2 +-
 6 files changed, 26 insertions(+), 1 deletion(-)

diff --git a/src/Juvix/Compiler/Core/Evaluator.hs b/src/Juvix/Compiler/Core/Evaluator.hs
index 8628b3cbe7..3204871428 100644
--- a/src/Juvix/Compiler/Core/Evaluator.hs
+++ b/src/Juvix/Compiler/Core/Evaluator.hs
@@ -95,6 +95,10 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
       case integerFromNode (eval' env r) of
         0 -> evalError "division by zero" (substEnv env n)
         k -> nodeFromInteger (div (integerFromNode (eval' env l)) k)
+    applyBuiltin n env OpIntMod [l, r] =
+      case integerFromNode (eval' env r) of
+        0 -> evalError "division by zero" (substEnv env n)
+        k -> nodeFromInteger (mod (integerFromNode (eval' env l)) k)
     applyBuiltin _ env OpIntEq [l, r] = nodeFromBool (integerFromNode (eval' env l) == integerFromNode (eval' env r))
     applyBuiltin _ env OpIntLt [l, r] = nodeFromBool (integerFromNode (eval' env l) < integerFromNode (eval' env r))
     applyBuiltin _ env OpIntLe [l, r] = nodeFromBool (integerFromNode (eval' env l) <= integerFromNode (eval' env r))
diff --git a/src/Juvix/Compiler/Core/Language/Builtins.hs b/src/Juvix/Compiler/Core/Language/Builtins.hs
index 53a957dccd..da30fab7f6 100644
--- a/src/Juvix/Compiler/Core/Language/Builtins.hs
+++ b/src/Juvix/Compiler/Core/Language/Builtins.hs
@@ -9,6 +9,7 @@ data BuiltinOp
   | OpIntSub
   | OpIntMul
   | OpIntDiv
+  | OpIntMod
   | OpIntEq
   | OpIntLt
   | OpIntLe
@@ -32,6 +33,7 @@ builtinOpArgsNum = \case
   OpIntSub -> 2
   OpIntMul -> 2
   OpIntDiv -> 2
+  OpIntMod -> 2
   OpIntEq -> 2
   OpIntLt -> 2
   OpIntLe -> 2
diff --git a/src/Juvix/Compiler/Core/Translation/FromSource.hs b/src/Juvix/Compiler/Core/Translation/FromSource.hs
index c39ff5117a..d7e61e228d 100644
--- a/src/Juvix/Compiler/Core/Translation/FromSource.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromSource.hs
@@ -372,6 +372,7 @@ factorExpr' ::
 factorExpr' varsNum vars node =
   mulExpr' varsNum vars node
     <|> divExpr' varsNum vars node
+    <|> modExpr' varsNum vars node
     <|> return node
 
 mulExpr' ::
@@ -396,6 +397,17 @@ divExpr' varsNum vars node = do
   node' <- appExpr varsNum vars
   factorExpr' varsNum vars (BuiltinApp Info.empty OpIntDiv [node, node'])
 
+modExpr' ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Index ->
+  HashMap Text Index ->
+  Node ->
+  ParsecS r Node
+modExpr' varsNum vars node = do
+  kwMod
+  node' <- appExpr varsNum vars
+  factorExpr' varsNum vars (BuiltinApp Info.empty OpIntMod [node, node'])
+
 appExpr ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
   Index ->
diff --git a/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs b/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs
index 3b980102a9..5a113348b2 100644
--- a/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs
@@ -77,6 +77,7 @@ allKeywords =
     kwMinus,
     kwMul,
     kwDiv,
+    kwMod,
     kwEq,
     kwLt,
     kwLe,
@@ -173,6 +174,9 @@ kwMul = keyword Str.mul
 kwDiv :: ParsecS r ()
 kwDiv = keyword Str.div
 
+kwMod :: ParsecS r ()
+kwMod = keyword Str.mod
+
 kwEq :: ParsecS r ()
 kwEq = keyword Str.equal
 
diff --git a/src/Juvix/Extra/Strings.hs b/src/Juvix/Extra/Strings.hs
index 9757996910..9c46bb7076 100644
--- a/src/Juvix/Extra/Strings.hs
+++ b/src/Juvix/Extra/Strings.hs
@@ -284,6 +284,9 @@ mul = "*"
 div :: IsString s => s
 div = "/"
 
+mod :: IsString s => s
+mod = "%"
+
 if_ :: IsString s => s
 if_ = "if"
 
diff --git a/tests/Core/positive/test011.jvc b/tests/Core/positive/test011.jvc
index 94db5f86e1..f383823b89 100644
--- a/tests/Core/positive/test011.jvc
+++ b/tests/Core/positive/test011.jvc
@@ -1,4 +1,4 @@
--- tail recursion: compute n-th Fibonacci number in O(n)
+-- tail recursion: compute the n-th Fibonacci number in O(n)
 
 def fib' := \n \x \y if n = 0 then x else fib' (n - 1) y (x + y);
 def fib := \n fib' n 0 1;

From 84415b60efe78696d00880e299a01c9ccbd4b2e1 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Thu, 18 Aug 2022 18:52:26 +0200
Subject: [PATCH 59/85] make bind left-associative

---
 .../Compiler/Core/Translation/FromSource.hs   | 23 ++++++++++++-------
 tests/Core/positive/out/test004.out           |  1 +
 tests/Core/positive/out/test006.out           |  2 +-
 tests/Core/positive/out/test009.out           |  1 -
 tests/Core/positive/test004.jvc               |  8 ++++++-
 tests/Core/positive/test006.jvc               |  2 +-
 tests/Core/positive/test009.jvc               |  3 +--
 7 files changed, 26 insertions(+), 14 deletions(-)

diff --git a/src/Juvix/Compiler/Core/Translation/FromSource.hs b/src/Juvix/Compiler/Core/Translation/FromSource.hs
index d7e61e228d..3c7b26176e 100644
--- a/src/Juvix/Compiler/Core/Translation/FromSource.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromSource.hs
@@ -200,15 +200,22 @@ expr ::
   -- reverse de Bruijn indices
   HashMap Text Index ->
   ParsecS r Node
-expr varsNum vars = bindExpr varsNum vars
+expr varsNum vars = ioExpr varsNum vars
 
-bindExpr ::
+ioExpr ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
   Index ->
   HashMap Text Index ->
   ParsecS r Node
-bindExpr varsNum vars = do
-  node <- cmpExpr varsNum vars
+ioExpr varsNum vars = cmpExpr varsNum vars >>= ioExpr' varsNum vars
+
+ioExpr' ::
+  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
+  Index ->
+  HashMap Text Index ->
+  Node ->
+  ParsecS r Node
+ioExpr' varsNum vars node = do
   bindExpr' varsNum vars node
     <|> seqExpr' varsNum vars node
     <|> return node
@@ -221,8 +228,8 @@ bindExpr' ::
   ParsecS r Node
 bindExpr' varsNum vars node = do
   kwBind
-  node' <- bindExpr varsNum vars
-  return $ ConstrApp Info.empty (BuiltinTag TagBind) [node, node']
+  node' <- cmpExpr varsNum vars
+  ioExpr' varsNum vars (ConstrApp Info.empty (BuiltinTag TagBind) [node, node'])
 
 seqExpr' ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
@@ -232,9 +239,9 @@ seqExpr' ::
   ParsecS r Node
 seqExpr' varsNum vars node = do
   ((), i) <- interval kwSeq
-  node' <- bindExpr (varsNum + 1) vars
+  node' <- cmpExpr (varsNum + 1) vars
   name <- lift $ freshName KNameLocal "_" i
-  return $
+  ioExpr' varsNum vars $
     ConstrApp
       Info.empty
       (BuiltinTag TagBind)
diff --git a/tests/Core/positive/out/test004.out b/tests/Core/positive/out/test004.out
index e56e15bb7d..b28e3e2177 100644
--- a/tests/Core/positive/out/test004.out
+++ b/tests/Core/positive/out/test004.out
@@ -1 +1,2 @@
 12345
+12345
diff --git a/tests/Core/positive/out/test006.out b/tests/Core/positive/out/test006.out
index d00491fd7e..0cfbf08886 100644
--- a/tests/Core/positive/out/test006.out
+++ b/tests/Core/positive/out/test006.out
@@ -1 +1 @@
-1
+2
diff --git a/tests/Core/positive/out/test009.out b/tests/Core/positive/out/test009.out
index 95cdc01c0c..b7a2459a37 100644
--- a/tests/Core/positive/out/test009.out
+++ b/tests/Core/positive/out/test009.out
@@ -1,3 +1,2 @@
 50005000
 5000050000
-500000500000
diff --git a/tests/Core/positive/test004.jvc b/tests/Core/positive/test004.jvc
index 2527c9882c..df6c543d7c 100644
--- a/tests/Core/positive/test004.jvc
+++ b/tests/Core/positive/test004.jvc
@@ -5,4 +5,10 @@ write 2 >>
 write 3 >>
 write 4 >>
 write 5 >>
-write "\n"
+write "\n" >>
+return 1 >>= write >>
+return 2 >>= write >>
+return 3 >>= write >>
+return 4 >>= write >>
+return 5 >>= write >>
+return "\n" >>= write
diff --git a/tests/Core/positive/test006.jvc b/tests/Core/positive/test006.jvc
index 71ed2233bc..e766bb9c6a 100644
--- a/tests/Core/positive/test006.jvc
+++ b/tests/Core/positive/test006.jvc
@@ -2,4 +2,4 @@
 
 def loop := loop;
 
-if 3 > 0 then 1 else loop
+(if 3 > 0 then 1 else loop) + (if 2 < 1 then loop else if 7 >= 8 then loop else 1)
diff --git a/tests/Core/positive/test009.jvc b/tests/Core/positive/test009.jvc
index fa5e1e5bc2..33af87dc38 100644
--- a/tests/Core/positive/test009.jvc
+++ b/tests/Core/positive/test009.jvc
@@ -24,5 +24,4 @@ def sum :=
 def writeLn := \x write x >> write "\n";
 
 writeLn (sum 10000) >>
-writeLn (sum 100000) >>
-writeLn (sum 1000000)
+writeLn (sum 100000)

From c15974a64902f405fcbe8a5ffbca96bebea0724e Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Thu, 18 Aug 2022 18:53:43 +0200
Subject: [PATCH 60/85] more tests

---
 tests/Core/benchmark/out/test003.out |  5 ++++
 tests/Core/benchmark/test003.jvc     | 13 ++++++++++
 tests/Core/positive/out/test012.out  |  5 ++++
 tests/Core/positive/out/test013.out  |  4 +++
 tests/Core/positive/out/test014.out  |  4 +++
 tests/Core/positive/out/test015.out  |  6 +++++
 tests/Core/positive/out/test016.out  |  1 +
 tests/Core/positive/out/test017.out  |  2 ++
 tests/Core/positive/out/test018.out  |  1 +
 tests/Core/positive/out/test019.out  |  1 +
 tests/Core/positive/out/test020.out  |  9 +++++++
 tests/Core/positive/out/test021.out  | 24 +++++++++++++++++
 tests/Core/positive/out/test022.out  |  3 +++
 tests/Core/positive/out/test023.out  | 10 +++++++
 tests/Core/positive/test012.jvc      | 29 +++++++++++++++++++++
 tests/Core/positive/test013.jvc      | 14 ++++++++++
 tests/Core/positive/test014.jvc      | 23 ++++++++++++++++
 tests/Core/positive/test015.jvc      | 21 +++++++++++++++
 tests/Core/positive/test016.jvc      |  6 +++++
 tests/Core/positive/test017.jvc      | 10 +++++++
 tests/Core/positive/test018.jvc      |  7 +++++
 tests/Core/positive/test019.jvc      |  3 +++
 tests/Core/positive/test020.jvc      | 20 ++++++++++++++
 tests/Core/positive/test021.jvc      | 26 +++++++++++++++++++
 tests/Core/positive/test022.jvc      | 30 +++++++++++++++++++++
 tests/Core/positive/test023.jvc      | 39 ++++++++++++++++++++++++++++
 26 files changed, 316 insertions(+)
 create mode 100644 tests/Core/benchmark/out/test003.out
 create mode 100644 tests/Core/benchmark/test003.jvc
 create mode 100644 tests/Core/positive/out/test012.out
 create mode 100644 tests/Core/positive/out/test013.out
 create mode 100644 tests/Core/positive/out/test014.out
 create mode 100644 tests/Core/positive/out/test015.out
 create mode 100644 tests/Core/positive/out/test016.out
 create mode 100644 tests/Core/positive/out/test017.out
 create mode 100644 tests/Core/positive/out/test018.out
 create mode 100644 tests/Core/positive/out/test019.out
 create mode 100644 tests/Core/positive/out/test020.out
 create mode 100644 tests/Core/positive/out/test021.out
 create mode 100644 tests/Core/positive/out/test022.out
 create mode 100644 tests/Core/positive/out/test023.out
 create mode 100644 tests/Core/positive/test012.jvc
 create mode 100644 tests/Core/positive/test013.jvc
 create mode 100644 tests/Core/positive/test014.jvc
 create mode 100644 tests/Core/positive/test015.jvc
 create mode 100644 tests/Core/positive/test016.jvc
 create mode 100644 tests/Core/positive/test017.jvc
 create mode 100644 tests/Core/positive/test018.jvc
 create mode 100644 tests/Core/positive/test019.jvc
 create mode 100644 tests/Core/positive/test020.jvc
 create mode 100644 tests/Core/positive/test021.jvc
 create mode 100644 tests/Core/positive/test022.jvc
 create mode 100644 tests/Core/positive/test023.jvc

diff --git a/tests/Core/benchmark/out/test003.out b/tests/Core/benchmark/out/test003.out
new file mode 100644
index 0000000000..852f88d3eb
--- /dev/null
+++ b/tests/Core/benchmark/out/test003.out
@@ -0,0 +1,5 @@
+50005000
+5000050000
+500000500000
+50000005000000
+5000000050000000
diff --git a/tests/Core/benchmark/test003.jvc b/tests/Core/benchmark/test003.jvc
new file mode 100644
index 0000000000..f3693ec0d7
--- /dev/null
+++ b/tests/Core/benchmark/test003.jvc
@@ -0,0 +1,13 @@
+-- tail recursion through higher-order functions
+
+def sumb := \f \x \acc if x = 0 then acc else f (x - 1) acc;
+def sum' := \x \acc sumb sum' x (x + acc);
+def sum := \x sum' x 0;
+
+def writeLn := \x write x >> write "\n";
+
+writeLn (sum 10000) >>
+writeLn (sum 100000) >>
+writeLn (sum 1000000) >>
+writeLn (sum 10000000) >>
+writeLn (sum 100000000)
diff --git a/tests/Core/positive/out/test012.out b/tests/Core/positive/out/test012.out
new file mode 100644
index 0000000000..5396d94af2
--- /dev/null
+++ b/tests/Core/positive/out/test012.out
@@ -0,0 +1,5 @@
+13200200200
+21320020020013200200200
+3213200200200132002002002132002002001320020020021320020020013200200200
+13213200200200132002002002132002002001320020020021320020020013200200200
+21321320020020013200200200213200200200132002002002132002002001320020020013213200200200132002002002132002002001320020020021320020020013200200200
diff --git a/tests/Core/positive/out/test013.out b/tests/Core/positive/out/test013.out
new file mode 100644
index 0000000000..8a49268b39
--- /dev/null
+++ b/tests/Core/positive/out/test013.out
@@ -0,0 +1,4 @@
+1
+0
+2
+5
diff --git a/tests/Core/positive/out/test014.out b/tests/Core/positive/out/test014.out
new file mode 100644
index 0000000000..5dbd7c07fc
--- /dev/null
+++ b/tests/Core/positive/out/test014.out
@@ -0,0 +1,4 @@
+7
+17
+37
+-29
diff --git a/tests/Core/positive/out/test015.out b/tests/Core/positive/out/test015.out
new file mode 100644
index 0000000000..0a2b6b13fb
--- /dev/null
+++ b/tests/Core/positive/out/test015.out
@@ -0,0 +1,6 @@
+600
+25
+30
+45
+55
+16
diff --git a/tests/Core/positive/out/test016.out b/tests/Core/positive/out/test016.out
new file mode 100644
index 0000000000..c3f407c095
--- /dev/null
+++ b/tests/Core/positive/out/test016.out
@@ -0,0 +1 @@
+55
diff --git a/tests/Core/positive/out/test017.out b/tests/Core/positive/out/test017.out
new file mode 100644
index 0000000000..b7a2459a37
--- /dev/null
+++ b/tests/Core/positive/out/test017.out
@@ -0,0 +1,2 @@
+50005000
+5000050000
diff --git a/tests/Core/positive/out/test018.out b/tests/Core/positive/out/test018.out
new file mode 100644
index 0000000000..b4de394767
--- /dev/null
+++ b/tests/Core/positive/out/test018.out
@@ -0,0 +1 @@
+11
diff --git a/tests/Core/positive/out/test019.out b/tests/Core/positive/out/test019.out
new file mode 100644
index 0000000000..7f8f011eb7
--- /dev/null
+++ b/tests/Core/positive/out/test019.out
@@ -0,0 +1 @@
+7
diff --git a/tests/Core/positive/out/test020.out b/tests/Core/positive/out/test020.out
new file mode 100644
index 0000000000..0b1f3d9ff0
--- /dev/null
+++ b/tests/Core/positive/out/test020.out
@@ -0,0 +1,9 @@
+91
+91
+91
+91
+100
+6
+6
+400
+4000
diff --git a/tests/Core/positive/out/test021.out b/tests/Core/positive/out/test021.out
new file mode 100644
index 0000000000..04d888dd93
--- /dev/null
+++ b/tests/Core/positive/out/test021.out
@@ -0,0 +1,24 @@
+6
+4
+7
+9
+40
+6
+3
+7
+9
+30
+6
+2
+7
+9
+20
+6
+1
+7
+9
+10
+6
+0
+7
+end
diff --git a/tests/Core/positive/out/test022.out b/tests/Core/positive/out/test022.out
new file mode 100644
index 0000000000..3e43902eab
--- /dev/null
+++ b/tests/Core/positive/out/test022.out
@@ -0,0 +1,3 @@
+8
+2187
+476837158203125
diff --git a/tests/Core/positive/out/test023.out b/tests/Core/positive/out/test023.out
new file mode 100644
index 0000000000..f3a9cf67e2
--- /dev/null
+++ b/tests/Core/positive/out/test023.out
@@ -0,0 +1,10 @@
+cons 10 (cons 9 (cons 8 (cons 7 (cons 6 (cons 5 (cons 4 (cons 3 (cons 2 (cons 1 nil)))))))))
+cons 1 (cons 2 (cons 3 (cons 4 (cons 5 (cons 6 (cons 7 (cons 8 (cons 9 (cons 10 nil)))))))))
+cons 10 (cons 9 (cons 8 (cons 7 (cons 6 nil))))
+cons 0 (cons 1 (cons 2 (cons 3 (cons 4 (cons 5 (cons 6 (cons 7 (cons 8 (cons 9 nil)))))))))
+50005000
+5000050000
+50005000
+5000050000
+50005000
+5000050000
diff --git a/tests/Core/positive/test012.jvc b/tests/Core/positive/test012.jvc
new file mode 100644
index 0000000000..9e0f27e63f
--- /dev/null
+++ b/tests/Core/positive/test012.jvc
@@ -0,0 +1,29 @@
+-- trees
+
+constr node1 1;
+constr node2 2;
+constr node3 3;
+constr leaf 0;
+
+def gen := \n
+  if n = 0 then
+    leaf
+  else if n % 3 = 0 then
+    node1 (gen (n - 1))
+  else if n % 3 = 1 then
+    node2 (gen (n - 1)) (gen (n - 1))
+  else
+    node3 (gen (n - 1)) (gen (n - 1)) (gen (n - 1));
+
+def preorder := \t case t of {
+  node1 c -> write 1 >> preorder c;
+  node2 l r -> write 2 >> preorder l >> preorder r;
+  node3 l m r -> write 3 >> preorder l >> preorder m >> preorder r;
+  leaf -> write 0;
+};
+
+preorder (gen 3) >> write "\n" >>
+preorder (gen 4) >> write "\n" >>
+preorder (gen 5) >> write "\n" >>
+preorder (gen 6) >> write "\n" >>
+preorder (gen 7) >> write "\n"
diff --git a/tests/Core/positive/test013.jvc b/tests/Core/positive/test013.jvc
new file mode 100644
index 0000000000..5bbc6bbced
--- /dev/null
+++ b/tests/Core/positive/test013.jvc
@@ -0,0 +1,14 @@
+-- functions returning functions with variable capture
+
+def f := \x
+  if x = 6 then \x 0
+  else if x = 5 then \x 1
+  else if x = 10 then \y (\x x) 2
+  else \x x;
+
+def writeLn := \x write x >> write "\n";
+
+writeLn (f 5 6) >>
+writeLn (f 6 5) >>
+writeLn (f 10 5) >>
+writeLn (f 11 5)
diff --git a/tests/Core/positive/test014.jvc b/tests/Core/positive/test014.jvc
new file mode 100644
index 0000000000..635af7bc39
--- /dev/null
+++ b/tests/Core/positive/test014.jvc
@@ -0,0 +1,23 @@
+-- arithmetic
+
+def writeLn := \x write x >> write "\n";
+
+def f := \x \y writeLn (x + y);
+
+def g := \x \y (x + 1) - (y * 7);
+
+def h := \f \y \z f y y * z;
+
+def x := 5;
+def y := 17;
+def func := \x x + 4;
+def z := 0;
+
+def vx := 30; def vy := 7;
+
+writeLn (func (y / x)) >> -- 17 div 5 + 4 = 7
+writeLn (+ (* z x) y) >> -- 17
+
+writeLn (+ vx (* vy (+ z 1))) >> -- 37
+
+f (h g 2 3) 4 -- (g 2 2) * 3 + 4 = (2+1-2*7)*3 + 4 = -11*3 + 4 = -33+4 = -29
diff --git a/tests/Core/positive/test015.jvc b/tests/Core/positive/test015.jvc
new file mode 100644
index 0000000000..70fc80de50
--- /dev/null
+++ b/tests/Core/positive/test015.jvc
@@ -0,0 +1,21 @@
+-- higher-order functions & local function definitions
+
+def f := \x {
+  let g := \y x + y in
+  if x = 0 then f 10
+  else if x < 10 then \y g (f (x - 1) y)
+  else g
+};
+
+def g := \x \h x + h x;
+
+def h := \x if x = 0 then 0 else g (x - 1) h;
+
+def writeLn := \x write x >> write "\n";
+
+writeLn (f 100 500) >> -- 600
+writeLn (f 5 0) >> -- 25
+writeLn (f 5 5) >> -- 30
+writeLn (h 10) >> -- 45
+writeLn (g 10 h) >> -- 55
+writeLn (g 3 (f 10)) -- 16
diff --git a/tests/Core/positive/test016.jvc b/tests/Core/positive/test016.jvc
new file mode 100644
index 0000000000..4960d1951e
--- /dev/null
+++ b/tests/Core/positive/test016.jvc
@@ -0,0 +1,6 @@
+-- recursion through higher-order functions
+
+def g := \f \x if x = 0 then 0 else f (x - 1);
+def f := \x x + g f x;
+
+f 10 -- 55
diff --git a/tests/Core/positive/test017.jvc b/tests/Core/positive/test017.jvc
new file mode 100644
index 0000000000..3f27647695
--- /dev/null
+++ b/tests/Core/positive/test017.jvc
@@ -0,0 +1,10 @@
+-- tail recursion through higher-order functions
+
+def sumb := \f \x \acc if x = 0 then acc else f (x - 1) acc;
+def sum' := \x \acc sumb sum' x (x + acc);
+def sum := \x sum' x 0;
+
+def writeLn := \x write x >> write "\n";
+
+writeLn (sum 10000) >>
+writeLn (sum 100000)
diff --git a/tests/Core/positive/test018.jvc b/tests/Core/positive/test018.jvc
new file mode 100644
index 0000000000..3e73ca1871
--- /dev/null
+++ b/tests/Core/positive/test018.jvc
@@ -0,0 +1,7 @@
+-- higher-order functions & recursion
+
+def f := \g g 5;
+def h := \x \z x + z;
+def u := \x f (h 4) + x;
+
+u 2 -- 11
diff --git a/tests/Core/positive/test019.jvc b/tests/Core/positive/test019.jvc
new file mode 100644
index 0000000000..b188d9369c
--- /dev/null
+++ b/tests/Core/positive/test019.jvc
@@ -0,0 +1,3 @@
+-- self-application
+
+(\x x x) (\x x) (3 + 4)
diff --git a/tests/Core/positive/test020.jvc b/tests/Core/positive/test020.jvc
new file mode 100644
index 0000000000..e024482156
--- /dev/null
+++ b/tests/Core/positive/test020.jvc
@@ -0,0 +1,20 @@
+-- recursive functions
+
+-- McCarthy's 91 function
+def f91 := \n if n > 100 then n - 10 else f91 (f91 (n + 11));
+
+-- subtraction by increments
+def subp := \i \j if i = j then 0 else subp i (j + 1) + 1;
+
+def writeLn := \x write x >> write "\n";
+
+writeLn (f91 101) >>
+writeLn (f91 95) >>
+writeLn (f91 16) >>
+writeLn (f91 5) >>
+
+writeLn (subp 101 1) >>
+writeLn (subp 11 5) >>
+writeLn (subp 10 4) >>
+writeLn (subp 1000 600) >>
+writeLn (subp 10000 6000)
diff --git a/tests/Core/positive/test021.jvc b/tests/Core/positive/test021.jvc
new file mode 100644
index 0000000000..6dea5ad699
--- /dev/null
+++ b/tests/Core/positive/test021.jvc
@@ -0,0 +1,26 @@
+-- higher-order recursive functions test
+
+def not := \x if x then false else true;
+
+def writeLn := \x write x >> write "\n";
+
+def f0 := \f \g \x {
+  writeLn 6 >>
+  writeLn x >>
+  writeLn 7 >>
+  if (not (x = 0)) then {
+    writeLn 9 >>
+    g x >>= \y
+    f f g y
+  } else
+    writeLn "end"
+};
+
+def g := \x {
+   writeLn (10 * x) >>
+   return (x - 1)
+};
+
+def f := f0 f0 g;
+
+f 4
diff --git a/tests/Core/positive/test022.jvc b/tests/Core/positive/test022.jvc
new file mode 100644
index 0000000000..c83b051d14
--- /dev/null
+++ b/tests/Core/positive/test022.jvc
@@ -0,0 +1,30 @@
+-- power
+
+def power' := \a \b \acc
+  if b = 0 then
+    acc
+  else if b % 2 = 0 then
+    power' (a * a) (b / 2) acc
+  else
+    power' (a * a) (b / 2) (acc * a);
+
+def power := \a \b power' a b 1;
+
+{-
+
+def power := loop a b (acc := 1) {
+  if b = 0 then
+    acc
+  else if b % 2 = 0 then
+    next (a * a) (b / 2) acc
+  else
+    next (a * a) (b / 2) (acc * a)
+};
+
+-}
+
+def writeLn := \x write x >> write "\n";
+
+writeLn (power 2 3) >>
+writeLn (power 3 7) >>
+writeLn (power 5 21)
diff --git a/tests/Core/positive/test023.jvc b/tests/Core/positive/test023.jvc
new file mode 100644
index 0000000000..d945c3eb6b
--- /dev/null
+++ b/tests/Core/positive/test023.jvc
@@ -0,0 +1,39 @@
+-- lists
+
+def head := \l case l of { cons h _ -> h };
+def tail := \l case l of { cons _ t -> t };
+def null := \l case l of { nil -> true; cons _ _ -> false };
+def map := \f \l case l of { nil -> nil; cons h t -> cons (f h) (map f t) };
+def foldl := \f \acc \l case l of { nil -> acc; cons h t -> foldl f (f acc h) t };
+def foldr := \f \acc \l case l of { nil -> acc; cons h t -> f h (foldr f acc t) };
+def filter := \f \l
+  case l of {
+    nil -> nil;
+    cons h t ->
+      if f h then
+        cons h (filter f t)
+      else
+        filter f t
+  };
+def rev := foldl (\acc \x cons x acc) nil;
+
+def gen := \n if n = 0 then nil else cons n (gen (n - 1));
+
+def sum := \n foldl (+) 0 (gen n);
+def sum' := \n foldr (+) 0 (gen n);
+
+def foldl' := \f \acc \l if null l then acc else foldl' f (f acc (head l)) (tail l);
+def sum'' := \n foldl' (+) 0 (gen n);
+
+def writeLn := \x write x >> write "\n";
+
+writeLn (gen 10) >>
+writeLn (rev (gen 10)) >>
+writeLn (filter (\x x > 5) (gen 10)) >>
+writeLn (rev (map (\x x - 1) (gen 10))) >>
+writeLn (sum 10000) >>
+writeLn (sum 100000) >>
+writeLn (sum' 10000) >>
+writeLn (sum' 100000) >>
+writeLn (sum' 10000) >>
+writeLn (sum' 100000)

From a0099a4d890b8dbeecee08cb506cc5a67f7f6e07 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Thu, 18 Aug 2022 22:42:01 +0200
Subject: [PATCH 61/85] pretty printing improvements

---
 src/Juvix/Compiler/Core/Evaluator.hs   |  8 ++++----
 src/Juvix/Compiler/Core/Pretty/Base.hs | 25 +++++++------------------
 src/Juvix/Extra/Strings.hs             |  9 ---------
 3 files changed, 11 insertions(+), 31 deletions(-)

diff --git a/src/Juvix/Compiler/Core/Evaluator.hs b/src/Juvix/Compiler/Core/Evaluator.hs
index 3204871428..c3cb4bacf4 100644
--- a/src/Juvix/Compiler/Core/Evaluator.hs
+++ b/src/Juvix/Compiler/Core/Evaluator.hs
@@ -66,15 +66,15 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
       ConstrApp i tag args -> Data i tag (map (eval' env) args)
       Lambda i b -> Closure i env b
       Let _ v b -> let !v' = eval' env v in eval' (v' : env) b
-      Case _ v bs def ->
+      Case i v bs def ->
         case eval' env v of
           Data _ tag args -> branch n env (revAppend args env) tag def bs
-          v' -> evalError "matching on non-data" v'
-      If _ v b1 b2 ->
+          v' -> evalError "matching on non-data" (substEnv env (Case i v' bs def))
+      If i v b1 b2 ->
         case eval' env v of
           Constant _ (ConstBool True) -> eval' env b1
           Constant _ (ConstBool False) -> eval' env b2
-          v' -> evalError "conditional branch on a non-boolean" v'
+          v' -> evalError "conditional branch on a non-boolean" (substEnv env (If i v' b1 b2))
       Data {} -> n
       Closure {} -> n
       Suspended {} -> n
diff --git a/src/Juvix/Compiler/Core/Pretty/Base.hs b/src/Juvix/Compiler/Core/Pretty/Base.hs
index 20f800b20a..8a0165b7c9 100644
--- a/src/Juvix/Compiler/Core/Pretty/Base.hs
+++ b/src/Juvix/Compiler/Core/Pretty/Base.hs
@@ -41,6 +41,7 @@ instance PrettyCode BuiltinOp where
     OpIntSub -> return kwMinus
     OpIntMul -> return kwMul
     OpIntDiv -> return kwDiv
+    OpIntMod -> return kwMod
     OpIntEq -> return kwEquals
     OpIntLt -> return kwLess
     OpIntLe -> return kwLessEquals
@@ -142,15 +143,9 @@ instance PrettyCode Node where
       b1 <- ppCode ifTrueBranch
       b2 <- ppCode ifFalseBranch
       return $ kwIf <+> v <+> kwThen <+> b1 <+> kwElse <+> b2
-    Data {..} -> do
-      args' <- mapM (ppRightExpression appFixity) dataArgs
-      n' <-
-        case Info.lookup kNameInfo dataInfo of
-          Just ni -> ppCode (ni ^. NameInfo.infoName)
-          Nothing -> ppCode dataTag
-      return $ kwConstrData <+> foldl (<+>) n' args'
-    Closure {} -> return kwClosure
-    Suspended {..} -> (<+>) kwSuspended <$> ppCode suspendedNode
+    Data {..} -> ppCode (ConstrApp dataInfo dataTag dataArgs)
+    Closure {..} -> ppCode (substEnv closureEnv closureBody)
+    Suspended {..} -> ppCode suspendedNode
 
 instance PrettyCode a => PrettyCode (NonEmpty a) where
   ppCode x = do
@@ -227,6 +222,9 @@ kwMul = keyword Str.mul
 kwDiv :: Doc Ann
 kwDiv = keyword Str.div
 
+kwMod :: Doc Ann
+kwMod = keyword Str.mod
+
 kwCase :: Doc Ann
 kwCase = keyword Str.case_
 
@@ -244,12 +242,3 @@ kwThen = keyword Str.then_
 
 kwElse :: Doc Ann
 kwElse = keyword Str.else_
-
-kwConstrData :: Doc Ann
-kwConstrData = keyword Str.constrData
-
-kwClosure :: Doc Ann
-kwClosure = keyword Str.closure
-
-kwSuspended :: Doc Ann
-kwSuspended = keyword Str.suspended
diff --git a/src/Juvix/Extra/Strings.hs b/src/Juvix/Extra/Strings.hs
index 9c46bb7076..f0e2f1c868 100644
--- a/src/Juvix/Extra/Strings.hs
+++ b/src/Juvix/Extra/Strings.hs
@@ -323,15 +323,6 @@ case_ = "case"
 of_ :: IsString s => s
 of_ = "of"
 
-closure :: IsString s => s
-closure = "<closure>"
-
-suspended :: IsString s => s
-suspended = "<suspended>"
-
-constrData :: IsString s => s
-constrData = "<data>"
-
 juvixFunctionT :: IsString s => s
 juvixFunctionT = "juvix_function_t"
 

From f9129954f380dee1666b96808d99cc56db21b851 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Thu, 18 Aug 2022 23:03:04 +0200
Subject: [PATCH 62/85] structural equality

---
 src/Juvix/Compiler/Core/Evaluator.hs          |  2 +-
 src/Juvix/Compiler/Core/Language.hs           | 20 +++++++++++++++++++
 src/Juvix/Compiler/Core/Language/Builtins.hs  |  4 ++--
 src/Juvix/Compiler/Core/Pretty/Base.hs        |  2 +-
 .../Compiler/Core/Translation/FromSource.hs   |  4 ++--
 tests/Core/positive/out/test024.out           |  8 ++++++++
 tests/Core/positive/test024.jvc               | 12 +++++++++++
 7 files changed, 46 insertions(+), 6 deletions(-)
 create mode 100644 tests/Core/positive/out/test024.out
 create mode 100644 tests/Core/positive/test024.jvc

diff --git a/src/Juvix/Compiler/Core/Evaluator.hs b/src/Juvix/Compiler/Core/Evaluator.hs
index c3cb4bacf4..23d92e53cd 100644
--- a/src/Juvix/Compiler/Core/Evaluator.hs
+++ b/src/Juvix/Compiler/Core/Evaluator.hs
@@ -99,9 +99,9 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
       case integerFromNode (eval' env r) of
         0 -> evalError "division by zero" (substEnv env n)
         k -> nodeFromInteger (mod (integerFromNode (eval' env l)) k)
-    applyBuiltin _ env OpIntEq [l, r] = nodeFromBool (integerFromNode (eval' env l) == integerFromNode (eval' env r))
     applyBuiltin _ env OpIntLt [l, r] = nodeFromBool (integerFromNode (eval' env l) < integerFromNode (eval' env r))
     applyBuiltin _ env OpIntLe [l, r] = nodeFromBool (integerFromNode (eval' env l) <= integerFromNode (eval' env r))
+    applyBuiltin _ env OpEq [l, r] = nodeFromBool (eval' env l == eval' env r)
     applyBuiltin n env _ _ = evalError "invalid builtin application" (substEnv env n)
 
     nodeFromInteger :: Integer -> Node
diff --git a/src/Juvix/Compiler/Core/Language.hs b/src/Juvix/Compiler/Core/Language.hs
index 648919b93f..dc2454c16a 100644
--- a/src/Juvix/Compiler/Core/Language.hs
+++ b/src/Juvix/Compiler/Core/Language.hs
@@ -95,6 +95,7 @@ data ConstantValue
   = ConstInteger !Integer
   | ConstBool !Bool
   | ConstString !Text
+  deriving stock (Eq)
 
 -- Other things we might need in the future:
 -- - ConstFloat
@@ -103,6 +104,7 @@ data ConstantValue
 -- - `argsNum` is the number of arguments of the constructor tagged with `tag`,
 --   equal to the number of implicit binders above `branch`
 data CaseBranch = CaseBranch {caseTag :: !Tag, caseBindersNum :: !Int, caseBranch :: !Node}
+  deriving stock (Eq)
 
 -- A node (term) is closed if it has no free variables, i.e., no de Bruijn
 -- indices pointing outside the term.
@@ -141,3 +143,21 @@ instance HasAtomicity Node where
 
 lambdaFixity :: Fixity
 lambdaFixity = Fixity (PrecNat 0) (Unary AssocPostfix)
+
+instance Eq Node where
+  (==) :: Node -> Node -> Bool
+  Var _ idx1 == Var _ idx2 = idx1 == idx2
+  Ident _ sym1 == Ident _ sym2 = sym1 == sym2
+  Constant _ v1 == Constant _ v2 = v1 == v2
+  Axiom _ == Axiom _ = True
+  App _ l1 r1 == App _ l2 r2 = l1 == l2 && r1 == r2
+  BuiltinApp _ op1 args1 == BuiltinApp _ op2 args2 = op1 == op2 && args1 == args2
+  ConstrApp _ tag1 args1 == ConstrApp _ tag2 args2 = tag1 == tag2 && args1 == args2
+  Lambda _ b1 == Lambda _ b2 = b1 == b2
+  Let _ v1 b1 == Let _ v2 b2 = v1 == v2 && b1 == b2
+  Case _ v1 bs1 def1 == Case _ v2 bs2 def2 = v1 == v2 && bs1 == bs2 && def1 == def2
+  If _ v1 tb1 fb1 == If _ v2 tb2 fb2 = v1 == v2 && tb1 == tb2 && fb1 == fb2
+  Data _ tag1 args1 == Data _ tag2 args2 = tag1 == tag2 && args1 == args2
+  Closure _ env1 b1 == Closure _ env2 b2 = env1 == env2 && b1 == b2
+  Suspended _ b1 == Suspended _ b2 = b1 == b2
+  _ == _ = False
diff --git a/src/Juvix/Compiler/Core/Language/Builtins.hs b/src/Juvix/Compiler/Core/Language/Builtins.hs
index da30fab7f6..9189d5a634 100644
--- a/src/Juvix/Compiler/Core/Language/Builtins.hs
+++ b/src/Juvix/Compiler/Core/Language/Builtins.hs
@@ -10,9 +10,9 @@ data BuiltinOp
   | OpIntMul
   | OpIntDiv
   | OpIntMod
-  | OpIntEq
   | OpIntLt
   | OpIntLe
+  | OpEq
   deriving stock (Eq)
 
 -- Builtin data tags
@@ -34,9 +34,9 @@ builtinOpArgsNum = \case
   OpIntMul -> 2
   OpIntDiv -> 2
   OpIntMod -> 2
-  OpIntEq -> 2
   OpIntLt -> 2
   OpIntLe -> 2
+  OpEq -> 2
 
 builtinConstrArgsNum :: BuiltinDataTag -> Int
 builtinConstrArgsNum = \case
diff --git a/src/Juvix/Compiler/Core/Pretty/Base.hs b/src/Juvix/Compiler/Core/Pretty/Base.hs
index 8a0165b7c9..7a25b1a8b9 100644
--- a/src/Juvix/Compiler/Core/Pretty/Base.hs
+++ b/src/Juvix/Compiler/Core/Pretty/Base.hs
@@ -42,9 +42,9 @@ instance PrettyCode BuiltinOp where
     OpIntMul -> return kwMul
     OpIntDiv -> return kwDiv
     OpIntMod -> return kwMod
-    OpIntEq -> return kwEquals
     OpIntLt -> return kwLess
     OpIntLe -> return kwLessEquals
+    OpEq -> return kwEquals
 
 instance PrettyCode BuiltinDataTag where
   ppCode = \case
diff --git a/src/Juvix/Compiler/Core/Translation/FromSource.hs b/src/Juvix/Compiler/Core/Translation/FromSource.hs
index 3c7b26176e..c85108cffc 100644
--- a/src/Juvix/Compiler/Core/Translation/FromSource.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromSource.hs
@@ -277,7 +277,7 @@ eqExpr' ::
 eqExpr' varsNum vars node = do
   kwEq
   node' <- arithExpr varsNum vars
-  return $ BuiltinApp Info.empty OpIntEq [node, node']
+  return $ BuiltinApp Info.empty OpEq [node, node']
 
 ltExpr' ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
@@ -429,7 +429,7 @@ builtinAppExpr ::
   ParsecS r Node
 builtinAppExpr varsNum vars = do
   op <-
-    (kwEq >> return OpIntEq)
+    (kwEq >> return OpEq)
       <|> (kwLt >> return OpIntLt)
       <|> (kwLe >> return OpIntLe)
       <|> (kwPlus >> return OpIntAdd)
diff --git a/tests/Core/positive/out/test024.out b/tests/Core/positive/out/test024.out
new file mode 100644
index 0000000000..0a60ee37e3
--- /dev/null
+++ b/tests/Core/positive/out/test024.out
@@ -0,0 +1,8 @@
+true
+false
+true
+false
+false
+true
+false
+true
diff --git a/tests/Core/positive/test024.jvc b/tests/Core/positive/test024.jvc
new file mode 100644
index 0000000000..9e76a97909
--- /dev/null
+++ b/tests/Core/positive/test024.jvc
@@ -0,0 +1,12 @@
+-- structural equality
+
+def writeLn := \x write x >> write "\n";
+
+writeLn (1 = 1) >>
+writeLn (0 = 1) >>
+writeLn (nil = nil) >>
+writeLn (cons 1 nil = nil) >>
+writeLn (cons 1 nil = cons 2 nil) >>
+writeLn (cons 1 nil = cons 1 nil) >>
+writeLn (cons 1 nil = cons 1 (cons 2 nil)) >>
+writeLn (cons 1 (cons 2 nil) = cons 1 (cons 2 nil))

From 7355e156d3265b9ea5a615d4de84909f741984c8 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Thu, 18 Aug 2022 23:17:34 +0200
Subject: [PATCH 63/85] remove Axiom & Suspended (axioms can be represented by
 special data constructors)

---
 src/Juvix/Compiler/Core/Evaluator.hs   |  6 +-----
 src/Juvix/Compiler/Core/Extra.hs       | 10 +---------
 src/Juvix/Compiler/Core/Extra/Base.hs  |  3 ---
 src/Juvix/Compiler/Core/Language.hs    | 10 ----------
 src/Juvix/Compiler/Core/Pretty/Base.hs |  5 -----
 5 files changed, 2 insertions(+), 32 deletions(-)

diff --git a/src/Juvix/Compiler/Core/Evaluator.hs b/src/Juvix/Compiler/Core/Evaluator.hs
index 23d92e53cd..9879da9dae 100644
--- a/src/Juvix/Compiler/Core/Evaluator.hs
+++ b/src/Juvix/Compiler/Core/Evaluator.hs
@@ -55,12 +55,9 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
       Var _ idx -> env !! idx
       Ident _ sym -> eval' [] (lookupContext n sym)
       Constant {} -> n
-      Axiom {} -> n
       App i l r ->
         case eval' env l of
           Closure _ env' b -> let !v = eval' env r in eval' (v : env') b
-          a@(Axiom {}) -> Suspended Info.empty (App Info.empty a (eval' env r))
-          Suspended i' t -> Suspended i' (App Info.empty t (eval' env r))
           v -> evalError "invalid application" (App i v (substEnv env r))
       BuiltinApp _ op args -> applyBuiltin n env op args
       ConstrApp i tag args -> Data i tag (map (eval' env) args)
@@ -77,7 +74,6 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
           v' -> evalError "conditional branch on a non-boolean" (substEnv env (If i v' b1 b2))
       Data {} -> n
       Closure {} -> n
-      Suspended {} -> n
 
     branch :: Node -> Env -> Env -> Tag -> Maybe Node -> [CaseBranch] -> Node
     branch n !denv !env !tag !def = \case
@@ -119,7 +115,7 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
     lookupContext n sym =
       case HashMap.lookup sym ctx of
         Just n' -> n'
-        Nothing -> Suspended Info.empty n
+        Nothing -> evalError "symbol not defined" n
 
     revAppend :: [a] -> [a] -> [a]
     revAppend [] ys = ys
diff --git a/src/Juvix/Compiler/Core/Extra.hs b/src/Juvix/Compiler/Core/Extra.hs
index ecd3851d4f..c37fa2aff3 100644
--- a/src/Juvix/Compiler/Core/Extra.hs
+++ b/src/Juvix/Compiler/Core/Extra.hs
@@ -96,13 +96,5 @@ convertData = umap go
       Data i tag args -> ConstrApp i tag args
       _ -> n
 
-convertSuspended :: Node -> Node
-convertSuspended = umap go
-  where
-    go :: Node -> Node
-    go n = case n of
-      Suspended _ t -> t
-      _ -> n
-
 convertRuntimeNodes :: Node -> Node
-convertRuntimeNodes = convertSuspended . convertData . convertClosures
+convertRuntimeNodes = convertData . convertClosures
diff --git a/src/Juvix/Compiler/Core/Extra/Base.hs b/src/Juvix/Compiler/Core/Extra/Base.hs
index 5aefc73c92..00ebb5e5bf 100644
--- a/src/Juvix/Compiler/Core/Extra/Base.hs
+++ b/src/Juvix/Compiler/Core/Extra/Base.hs
@@ -90,7 +90,6 @@ destruct = \case
   Var i idx -> NodeDetails i [] [] [] (\i' _ -> Var i' idx)
   Ident i sym -> NodeDetails i [] [] [] (\i' _ -> Ident i' sym)
   Constant i c -> NodeDetails i [] [] [] (\i' _ -> Constant i' c)
-  Axiom i -> NodeDetails i [] [] [] (\i' _ -> Axiom i')
   App i l r -> NodeDetails i [l, r] [0, 0] [Nothing, Nothing] (\i' args' -> App i' (hd args') (args' !! 1))
   BuiltinApp i op args -> NodeDetails i args (map (const 0) args) (map (const Nothing) args) (`BuiltinApp` op)
   ConstrApp i tag args -> NodeDetails i args (map (const 0) args) (map (const Nothing) args) (`ConstrApp` tag)
@@ -146,8 +145,6 @@ destruct = \case
       (1 : map (const 0) env)
       (fetchBinderInfo i : map (const Nothing) env)
       (\i' args' -> Closure i' (tl args') (hd args'))
-  Suspended i t ->
-    NodeDetails i [t] [0] [Nothing] (\i' args' -> Suspended i' (hd args'))
   where
     fetchBinderInfo :: Info -> Maybe [BinderInfo]
     fetchBinderInfo i = case Info.lookup kBinderInfo i of
diff --git a/src/Juvix/Compiler/Core/Language.hs b/src/Juvix/Compiler/Core/Language.hs
index dc2454c16a..bf679dff9a 100644
--- a/src/Juvix/Compiler/Core/Language.hs
+++ b/src/Juvix/Compiler/Core/Language.hs
@@ -29,8 +29,6 @@ data Node
     -- context).
     Ident {identInfo :: !Info, identSymbol :: !Symbol}
   | Constant {constantInfo :: !Info, constantValue :: !ConstantValue}
-  | -- An axiom. Computationally a unit.
-    Axiom {axiomInfo :: !Info}
   | App {appInfo :: !Info, appLeft :: !Node, appRight :: !Node}
   | -- A builtin application. A builtin has no corresponding Node. It is treated
     -- specially by the evaluator and the code generator. For example, basic
@@ -76,10 +74,6 @@ data Node
         closureEnv :: !Env,
         closureBody :: !Node
       }
-  | -- Evaluation only: a suspended term value which cannot be evaluated
-    -- further, e.g., a hole applied to some arguments. `suspendedNode` must
-    -- be closed (but need not be a value -- see below).
-    Suspended {suspendedInfo :: !Info, suspendedNode :: !Node}
 
 -- Other things we might need in the future:
 -- - laziness annotations (converting these to closure/thunk creation should be
@@ -127,7 +121,6 @@ instance HasAtomicity Node where
     Var {} -> Atom
     Ident {} -> Atom
     Constant {} -> Atom
-    Axiom {} -> Atom
     App {} -> Aggregate appFixity
     BuiltinApp {..} | null builtinArgs -> Atom
     BuiltinApp {} -> Aggregate lambdaFixity
@@ -139,7 +132,6 @@ instance HasAtomicity Node where
     If {} -> Aggregate lambdaFixity
     Data {} -> Aggregate lambdaFixity
     Closure {} -> Aggregate lambdaFixity
-    Suspended {} -> Aggregate lambdaFixity
 
 lambdaFixity :: Fixity
 lambdaFixity = Fixity (PrecNat 0) (Unary AssocPostfix)
@@ -149,7 +141,6 @@ instance Eq Node where
   Var _ idx1 == Var _ idx2 = idx1 == idx2
   Ident _ sym1 == Ident _ sym2 = sym1 == sym2
   Constant _ v1 == Constant _ v2 = v1 == v2
-  Axiom _ == Axiom _ = True
   App _ l1 r1 == App _ l2 r2 = l1 == l2 && r1 == r2
   BuiltinApp _ op1 args1 == BuiltinApp _ op2 args2 = op1 == op2 && args1 == args2
   ConstrApp _ tag1 args1 == ConstrApp _ tag2 args2 = tag1 == tag2 && args1 == args2
@@ -159,5 +150,4 @@ instance Eq Node where
   If _ v1 tb1 fb1 == If _ v2 tb2 fb2 = v1 == v2 && tb1 == tb2 && fb1 == fb2
   Data _ tag1 args1 == Data _ tag2 args2 = tag1 == tag2 && args1 == args2
   Closure _ env1 b1 == Closure _ env2 b2 = env1 == env2 && b1 == b2
-  Suspended _ b1 == Suspended _ b2 = b1 == b2
   _ == _ = False
diff --git a/src/Juvix/Compiler/Core/Pretty/Base.hs b/src/Juvix/Compiler/Core/Pretty/Base.hs
index 7a25b1a8b9..955df0ef32 100644
--- a/src/Juvix/Compiler/Core/Pretty/Base.hs
+++ b/src/Juvix/Compiler/Core/Pretty/Base.hs
@@ -78,10 +78,6 @@ instance PrettyCode Node where
       return $ annotate (AnnKind KNameConstructor) (pretty ("false" :: String))
     Constant _ (ConstString txt) ->
       return $ annotate AnnLiteralString (pretty (show txt :: String))
-    Axiom {..} ->
-      case Info.lookup kNameInfo axiomInfo of
-        Just ni -> ppCode (ni ^. NameInfo.infoName)
-        Nothing -> return kwQuestion
     App {..} -> do
       l' <- ppLeftExpression appFixity appLeft
       r' <- ppRightExpression appFixity appRight
@@ -145,7 +141,6 @@ instance PrettyCode Node where
       return $ kwIf <+> v <+> kwThen <+> b1 <+> kwElse <+> b2
     Data {..} -> ppCode (ConstrApp dataInfo dataTag dataArgs)
     Closure {..} -> ppCode (substEnv closureEnv closureBody)
-    Suspended {..} -> ppCode suspendedNode
 
 instance PrettyCode a => PrettyCode (NonEmpty a) where
   ppCode x = do

From e8e092667a3b76a0d331b8faa20c90757d0c6bef Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Fri, 19 Aug 2022 19:03:39 +0200
Subject: [PATCH 64/85] :l and :r REPL commands

---
 app/Main.hs                         | 14 ++++++++++++++
 tests/Core/positive/out/test009.out |  2 ++
 tests/Core/positive/test009.jvc     | 11 +++++++++++
 3 files changed, 27 insertions(+)

diff --git a/app/Main.hs b/app/Main.hs
index 4edc639fe9..4c2c9d9bd4 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -321,6 +321,18 @@ runCoreCommand globalOpts = \case
                 replEval True tab' node
               Right (tab', Nothing) ->
                 runRepl tab'
+          ':' : 'l' : ' ' : f -> do
+            s' <- embed (readFile f)
+            case Core.runParser "" f Core.emptyInfoTable s' of
+              Left err -> do
+                printJuvixError (JuvixError err)
+                runRepl tab
+              Right (tab', Just node) ->
+                replEval True tab' node
+              Right (tab', Nothing) ->
+                runRepl tab'
+          ":r" ->
+            runRepl Core.emptyInfoTable
           _ ->
             case Core.parseText tab s of
               Left err -> do
@@ -365,6 +377,8 @@ runCoreCommand globalOpts = \case
       putStrLn "Available commands:"
       putStrLn ":p expr               Pretty print \"expr\"."
       putStrLn ":e expr               Evaluate \"expr\" without interpreting IO actions."
+      putStrLn ":l file               Load and evaluate \"file\". Resets REPL state."
+      putStrLn ":r                    Reset REPL state."
       putStrLn ":q                    Quit."
       putStrLn ":h                    Display this help message."
       putStrLn ""
diff --git a/tests/Core/positive/out/test009.out b/tests/Core/positive/out/test009.out
index b7a2459a37..1f6fb3c152 100644
--- a/tests/Core/positive/out/test009.out
+++ b/tests/Core/positive/out/test009.out
@@ -1,2 +1,4 @@
 50005000
 5000050000
+120
+3628800
diff --git a/tests/Core/positive/test009.jvc b/tests/Core/positive/test009.jvc
index 33af87dc38..e6a824d0d1 100644
--- a/tests/Core/positive/test009.jvc
+++ b/tests/Core/positive/test009.jvc
@@ -21,6 +21,17 @@ def sum :=
 
 -}
 
+def fact' := \x \acc if x = 0 then acc else fact' (x - 1) (acc * x);
+def fact := \x fact' x 1;
+
+{-
+
+def fact := loop x (acc := 1) {
+  if x = 0 then acc else next (x - 1) (acc * x)
+};
+
+-}
+
 def writeLn := \x write x >> write "\n";
 
 writeLn (sum 10000) >>

From c06cfb3935fe178b426f1970d94f1ac69f900316 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Fri, 19 Aug 2022 19:16:56 +0200
Subject: [PATCH 65/85] :l bugfix

---
 app/Main.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/app/Main.hs b/app/Main.hs
index 4c2c9d9bd4..52cd9a45c3 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -328,7 +328,7 @@ runCoreCommand globalOpts = \case
                 printJuvixError (JuvixError err)
                 runRepl tab
               Right (tab', Just node) ->
-                replEval True tab' node
+                replEval False tab' node
               Right (tab', Nothing) ->
                 runRepl tab'
           ":r" ->

From 34119033f724bc1905cc907826132845f6133ec2 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Fri, 19 Aug 2022 20:16:55 +0200
Subject: [PATCH 66/85] --show-de-bruijn option for REPL

---
 app/Commands/Dev/Core.hs                  | 18 +++++++++--
 app/Main.hs                               | 38 ++++++++++++-----------
 src/Juvix/Compiler/Core/Evaluator.hs      | 14 ++++-----
 src/Juvix/Compiler/Core/Pretty/Base.hs    |  8 ++++-
 src/Juvix/Compiler/Core/Pretty/Options.hs |  6 ++--
 5 files changed, 54 insertions(+), 30 deletions(-)

diff --git a/app/Commands/Dev/Core.hs b/app/Commands/Dev/Core.hs
index b0a54f20df..a3220e2d62 100644
--- a/app/Commands/Dev/Core.hs
+++ b/app/Commands/Dev/Core.hs
@@ -4,13 +4,18 @@ import Juvix.Prelude hiding (Doc)
 import Options.Applicative
 
 data CoreCommand
-  = Repl
+  = Repl CoreReplOptions
   | Eval CoreEvalOptions
 
+newtype CoreReplOptions = CoreReplOptions
+  { _coreReplShowDeBruijn :: Bool
+  }
+
 newtype CoreEvalOptions = CoreEvalOptions
   { _coreEvalNoIO :: Bool
   }
 
+makeLenses ''CoreReplOptions
 makeLenses ''CoreEvalOptions
 
 defaultCoreEvalOptions :: CoreEvalOptions
@@ -36,7 +41,7 @@ parseCoreCommand =
     replInfo :: ParserInfo CoreCommand
     replInfo =
       info
-        (pure Repl)
+        (Repl <$> parseCoreReplOptions)
         (progDesc "Start an interactive session of the JuvixCore evaluator")
 
     evalInfo :: ParserInfo CoreCommand
@@ -53,3 +58,12 @@ parseCoreEvalOptions = do
           <> help "Don't interpret the IO effects"
       )
   pure CoreEvalOptions {..}
+
+parseCoreReplOptions :: Parser CoreReplOptions
+parseCoreReplOptions = do
+  _coreReplShowDeBruijn <-
+    switch
+      ( long "show-de-bruijn"
+          <> help "Show variable de Bruijn indices"
+      )
+  pure CoreReplOptions {..}
diff --git a/app/Main.hs b/app/Main.hs
index 52cd9a45c3..e9fb6c254c 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -277,9 +277,9 @@ runCommand cmdWithOpts = do
 
 runCoreCommand :: Members '[Embed IO, App] r => GlobalOptions -> CoreCommand -> Sem r ()
 runCoreCommand globalOpts = \case
-  Repl -> do
+  Repl opts -> do
     embed showReplWelcome
-    runRepl Core.emptyInfoTable
+    runRepl opts Core.emptyInfoTable
   Eval opts ->
     case globalOpts ^. globalInputFiles of
       [] -> printFailureExit "Provide a JuvixCore file to run this command\nUse --help to see all the options"
@@ -288,9 +288,10 @@ runCoreCommand globalOpts = \case
     runRepl ::
       forall r.
       Members '[Embed IO, App] r =>
+      CoreReplOptions ->
       Core.InfoTable ->
       Sem r ()
-    runRepl tab = do
+    runRepl opts tab = do
       embed (putStr "> ")
       embed (hFlush stdout)
       done <- embed isEOF
@@ -300,48 +301,48 @@ runCoreCommand globalOpts = \case
           ":q" -> return ()
           ":h" -> do
             embed showReplHelp
-            runRepl tab
+            runRepl opts tab
           ':' : 'p' : ' ' : s' ->
             case Core.parseText tab (fromString s') of
               Left err -> do
                 printJuvixError (JuvixError err)
-                runRepl tab
+                runRepl opts tab
               Right (tab', Just node) -> do
                 renderStdOut (Core.ppOutDefault node)
                 embed (putStrLn "")
-                runRepl tab'
+                runRepl opts tab'
               Right (tab', Nothing) ->
-                runRepl tab'
+                runRepl opts tab'
           ':' : 'e' : ' ' : s' ->
             case Core.parseText tab (fromString s') of
               Left err -> do
                 printJuvixError (JuvixError err)
-                runRepl tab
+                runRepl opts tab
               Right (tab', Just node) ->
                 replEval True tab' node
               Right (tab', Nothing) ->
-                runRepl tab'
+                runRepl opts tab'
           ':' : 'l' : ' ' : f -> do
             s' <- embed (readFile f)
             case Core.runParser "" f Core.emptyInfoTable s' of
               Left err -> do
                 printJuvixError (JuvixError err)
-                runRepl tab
+                runRepl opts tab
               Right (tab', Just node) ->
                 replEval False tab' node
               Right (tab', Nothing) ->
-                runRepl tab'
+                runRepl opts tab'
           ":r" ->
-            runRepl Core.emptyInfoTable
+            runRepl opts Core.emptyInfoTable
           _ ->
             case Core.parseText tab s of
               Left err -> do
                 printJuvixError (JuvixError err)
-                runRepl tab
+                runRepl opts tab
               Right (tab', Just node) ->
                 replEval False tab' node
               Right (tab', Nothing) ->
-                runRepl tab'
+                runRepl opts tab'
       where
         replEval :: Bool -> Core.InfoTable -> Core.Node -> Sem r ()
         replEval noIO tab' node = do
@@ -349,16 +350,17 @@ runCoreCommand globalOpts = \case
           case r of
             Left err -> do
               printJuvixError (JuvixError err)
-              runRepl tab'
+              runRepl opts tab'
             Right node'
               | Info.member Info.kNoDisplayInfo (Core.getInfo node') ->
-                  runRepl tab'
+                  runRepl opts tab'
             Right node' -> do
-              renderStdOut (Core.ppOutDefault node')
+              renderStdOut (Core.ppOut docOpts node')
               embed (putStrLn "")
-              runRepl tab'
+              runRepl opts tab'
           where
             defaultLoc = singletonInterval (mkLoc "stdin" 0 (M.initialPos "stdin"))
+            docOpts = set Core.optShowDeBruijnIndices (opts ^. coreReplShowDeBruijn) Core.defaultOptions
 
     showReplWelcome :: IO ()
     showReplWelcome = do
diff --git a/src/Juvix/Compiler/Core/Evaluator.hs b/src/Juvix/Compiler/Core/Evaluator.hs
index 9879da9dae..764ed521e8 100644
--- a/src/Juvix/Compiler/Core/Evaluator.hs
+++ b/src/Juvix/Compiler/Core/Evaluator.hs
@@ -65,7 +65,7 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
       Let _ v b -> let !v' = eval' env v in eval' (v' : env) b
       Case i v bs def ->
         case eval' env v of
-          Data _ tag args -> branch n env (revAppend args env) tag def bs
+          Data _ tag args -> branch n env args tag def bs
           v' -> evalError "matching on non-data" (substEnv env (Case i v' bs def))
       If i v b1 b2 ->
         case eval' env v of
@@ -75,13 +75,13 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
       Data {} -> n
       Closure {} -> n
 
-    branch :: Node -> Env -> Env -> Tag -> Maybe Node -> [CaseBranch] -> Node
-    branch n !denv !env !tag !def = \case
-      (CaseBranch tag' _ b) : _ | tag' == tag -> eval' env b
-      _ : bs' -> branch n denv env tag def bs'
+    branch :: Node -> Env -> [Node] -> Tag -> Maybe Node -> [CaseBranch] -> Node
+    branch n !env !args !tag !def = \case
+      (CaseBranch tag' _ b) : _ | tag' == tag -> eval' (revAppend args env) b
+      _ : bs' -> branch n env args tag def bs'
       [] -> case def of
-        Just b -> eval' denv b
-        Nothing -> evalError "no matching case branch" (substEnv denv n)
+        Just b -> eval' env b
+        Nothing -> evalError "no matching case branch" (substEnv env n)
 
     applyBuiltin :: Node -> Env -> BuiltinOp -> [Node] -> Node
     applyBuiltin _ env OpIntAdd [l, r] = nodeFromInteger (integerFromNode (eval' env l) + integerFromNode (eval' env r))
diff --git a/src/Juvix/Compiler/Core/Pretty/Base.hs b/src/Juvix/Compiler/Core/Pretty/Base.hs
index 955df0ef32..87848b7a96 100644
--- a/src/Juvix/Compiler/Core/Pretty/Base.hs
+++ b/src/Juvix/Compiler/Core/Pretty/Base.hs
@@ -64,7 +64,13 @@ instance PrettyCode Node where
   ppCode node = case node of
     Var {..} ->
       case Info.lookup kNameInfo varInfo of
-        Just ni -> ppCode (ni ^. NameInfo.infoName)
+        Just ni -> do
+          showDeBruijn <- asks (^. optShowDeBruijnIndices)
+          n <- ppCode (ni ^. NameInfo.infoName)
+          if showDeBruijn then
+            return $ n <> kwDeBruijnVar <> pretty varIndex
+          else
+            return n
         Nothing -> return $ kwDeBruijnVar <> pretty varIndex
     Ident {..} ->
       case Info.lookup kNameInfo identInfo of
diff --git a/src/Juvix/Compiler/Core/Pretty/Options.hs b/src/Juvix/Compiler/Core/Pretty/Options.hs
index fabfe89991..2386deb6ad 100644
--- a/src/Juvix/Compiler/Core/Pretty/Options.hs
+++ b/src/Juvix/Compiler/Core/Pretty/Options.hs
@@ -4,14 +4,16 @@ import Juvix.Prelude
 
 data Options = Options
   { _optIndent :: Int,
-    _optShowNameIds :: Bool
+    _optShowNameIds :: Bool,
+    _optShowDeBruijnIndices :: Bool
   }
 
 defaultOptions :: Options
 defaultOptions =
   Options
     { _optIndent = 2,
-      _optShowNameIds = False
+      _optShowNameIds = False,
+      _optShowDeBruijnIndices = False
     }
 
 makeLenses ''Options

From ae09332d4f8e0a3f60a760eb1732cc73b204f9d4 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Fri, 19 Aug 2022 23:13:53 +0200
Subject: [PATCH 67/85] tests

---
 tests/Core/positive/out/test025.out      |  2 ++
 tests/Core/positive/out/test026.out      |  6 ++++
 tests/Core/positive/out/test027.out      |  5 +++
 tests/Core/positive/out/test037.out      |  1 +
 tests/Core/positive/out/test038.out      |  1 +
 tests/Core/positive/reference/test026.hs | 32 +++++++++++++++++++
 tests/Core/positive/test025.jvc          | 31 ++++++++++++++++++
 tests/Core/positive/test026.jvc          | 40 ++++++++++++++++++++++++
 tests/Core/positive/test027.jvc          | 18 +++++++++++
 tests/Core/positive/test028.jvc          | 39 +++++++++++++++++++++++
 tests/Core/positive/test029.jvc          |  1 +
 tests/Core/positive/test030.jvc          |  1 +
 tests/Core/positive/test031.jvc          |  1 +
 tests/Core/positive/test032.jvc          |  1 +
 tests/Core/positive/test033.jvc          |  1 +
 tests/Core/positive/test034.jvc          |  1 +
 tests/Core/positive/test035.jvc          |  1 +
 tests/Core/positive/test036.jvc          |  1 +
 tests/Core/positive/test037.jvc          | 11 +++++++
 tests/Core/positive/test038.jvc          | 11 +++++++
 20 files changed, 205 insertions(+)
 create mode 100644 tests/Core/positive/out/test025.out
 create mode 100644 tests/Core/positive/out/test026.out
 create mode 100644 tests/Core/positive/out/test027.out
 create mode 100644 tests/Core/positive/out/test037.out
 create mode 100644 tests/Core/positive/out/test038.out
 create mode 100644 tests/Core/positive/reference/test026.hs
 create mode 100644 tests/Core/positive/test025.jvc
 create mode 100644 tests/Core/positive/test026.jvc
 create mode 100644 tests/Core/positive/test027.jvc
 create mode 100644 tests/Core/positive/test028.jvc
 create mode 100644 tests/Core/positive/test029.jvc
 create mode 100644 tests/Core/positive/test030.jvc
 create mode 100644 tests/Core/positive/test031.jvc
 create mode 100644 tests/Core/positive/test032.jvc
 create mode 100644 tests/Core/positive/test033.jvc
 create mode 100644 tests/Core/positive/test034.jvc
 create mode 100644 tests/Core/positive/test035.jvc
 create mode 100644 tests/Core/positive/test036.jvc
 create mode 100644 tests/Core/positive/test037.jvc
 create mode 100644 tests/Core/positive/test038.jvc

diff --git a/tests/Core/positive/out/test025.out b/tests/Core/positive/out/test025.out
new file mode 100644
index 0000000000..b2058379a3
--- /dev/null
+++ b/tests/Core/positive/out/test025.out
@@ -0,0 +1,2 @@
+120
+3628800
diff --git a/tests/Core/positive/out/test026.out b/tests/Core/positive/out/test026.out
new file mode 100644
index 0000000000..a5e1d4be0b
--- /dev/null
+++ b/tests/Core/positive/out/test026.out
@@ -0,0 +1,6 @@
+-12096
+-1448007509520
+5510602057585725
+-85667472308246220
+527851146861989286336
+-441596546382859135501706333021475
diff --git a/tests/Core/positive/out/test027.out b/tests/Core/positive/out/test027.out
new file mode 100644
index 0000000000..f513e60960
--- /dev/null
+++ b/tests/Core/positive/out/test027.out
@@ -0,0 +1,5 @@
+14
+70
+1
+1
+1
diff --git a/tests/Core/positive/out/test037.out b/tests/Core/positive/out/test037.out
new file mode 100644
index 0000000000..987e7ca9a7
--- /dev/null
+++ b/tests/Core/positive/out/test037.out
@@ -0,0 +1 @@
+77
diff --git a/tests/Core/positive/out/test038.out b/tests/Core/positive/out/test038.out
new file mode 100644
index 0000000000..b1bd38b62a
--- /dev/null
+++ b/tests/Core/positive/out/test038.out
@@ -0,0 +1 @@
+13
diff --git a/tests/Core/positive/reference/test026.hs b/tests/Core/positive/reference/test026.hs
new file mode 100644
index 0000000000..b5074ef75a
--- /dev/null
+++ b/tests/Core/positive/reference/test026.hs
@@ -0,0 +1,32 @@
+
+data Tree = Leaf | Node Tree Tree
+
+gen :: Int -> Tree
+gen n = if n <= 0 then Leaf else Node (gen (n - 2)) (gen (n - 1))
+
+f :: Tree -> Integer
+f Leaf = 1
+f (Node l r) =
+  let l' = g l in
+  let r' = g r in
+  let a = case l' of
+        Leaf -> -3
+        Node l r -> f l + f r
+  in
+  let b = case r' of
+        Node l r -> f l + f r
+        _ -> 2
+  in
+  a * b
+
+isNode :: Tree -> Bool
+isNode (Node _ _ ) = True
+isNode Leaf = False
+
+isLeaf :: Tree -> Bool
+isLeaf Leaf = True
+isLeaf _ = False
+
+g :: Tree -> Tree
+g t = if isLeaf t then t else case t of
+      Node l r -> if isNode l then r else Node r l
diff --git a/tests/Core/positive/test025.jvc b/tests/Core/positive/test025.jvc
new file mode 100644
index 0000000000..18c98dd714
--- /dev/null
+++ b/tests/Core/positive/test025.jvc
@@ -0,0 +1,31 @@
+-- mutual recursion
+
+def g;
+
+def f := \x {
+  if x < 1 then
+    1
+  else
+    x * g (x - 1)
+};
+
+def h;
+
+def g := \x {
+  if x < 1 then
+    1
+  else
+    x * h (x - 1)
+};
+
+def h := \x {
+  if x < 1 then
+    1
+  else
+    x * f (x - 1)
+};
+
+def writeLn := \x write x >> write "\n";
+
+writeLn (f 5) >>
+writeLn (f 10)
diff --git a/tests/Core/positive/test026.jvc b/tests/Core/positive/test026.jvc
new file mode 100644
index 0000000000..a40507307d
--- /dev/null
+++ b/tests/Core/positive/test026.jvc
@@ -0,0 +1,40 @@
+-- nested case, let & if
+
+constr leaf 0;
+constr node 2;
+
+def gen := \n if n <= 0 then leaf else node (gen (n - 2)) (gen (n - 1));
+
+def g;
+
+def f := \t case t of {
+  leaf -> 1;
+  node l r ->
+    let l := g l in
+    let r := g r in
+    let a := case l of {
+      leaf -> 0 - 3;
+      node l r -> f l + f r
+    } in
+    let b := case r of {
+      node l r -> f l + f r;
+      _ -> 2
+    } in
+    a * b
+};
+
+def isNode := \t case t of { node _ _ -> true; _ -> false };
+def isLeaf := \t case t of { leaf -> true; _ -> false };
+
+def g := \t if isLeaf t then t else case t of {
+  node l r -> if isNode l then r else node r l
+};
+
+def writeLn := \x write x >> write "\n";
+
+writeLn (f (gen 10)) >>
+writeLn (f (gen 15)) >>
+writeLn (f (gen 16)) >>
+writeLn (f (gen 17)) >>
+writeLn (f (gen 18)) >>
+writeLn (f (gen 20))
diff --git a/tests/Core/positive/test027.jvc b/tests/Core/positive/test027.jvc
new file mode 100644
index 0000000000..ae00ca518a
--- /dev/null
+++ b/tests/Core/positive/test027.jvc
@@ -0,0 +1,18 @@
+-- Euclid's algorithm
+
+def gcd := \a \b {
+  if a > b then
+    gcd b a
+  else if a = 0 then
+    b
+  else
+    gcd (b % a) a
+};
+
+def writeLn := \x write x >> write "\n";
+
+writeLn (gcd (3 * 7 * 2) (7 * 2)) >>
+writeLn (gcd (3 * 7 * 2 * 11 * 5) (7 * 2 * 5)) >>
+writeLn (gcd 3 7) >>
+writeLn (gcd 7 3) >>
+writeLn (gcd (11 * 7 * 3) (2 * 5 * 13))
diff --git a/tests/Core/positive/test028.jvc b/tests/Core/positive/test028.jvc
new file mode 100644
index 0000000000..3e322c15c4
--- /dev/null
+++ b/tests/Core/positive/test028.jvc
@@ -0,0 +1,39 @@
+-- functional queues
+
+def hd := \l case l of { cons x _ -> x };
+def tl := \l case l of { cons _ x -> x };
+
+def rev' := \l \acc case l of {
+  nil -> acc;
+  cons h t -> rev' t (cons h acc)
+};
+
+def rev := \l rev' l nil;
+
+constr queue 2;
+
+def fst := \q case q of { queue x _ -> x };
+def snd := \q case q of { queue _ x -> x };
+
+def front := \q hd (fst q);
+
+def pop_front := \q \x
+  let q' := queue (tl (fst q)) (snd q) in
+  case fst q' of {
+    nil -> queue (rev (snd q')) nil;
+    _ -> q'
+  };
+
+def push_back := \q \x queue (fst q) (cons x (snd q));
+
+def is_empty := \q case fst q of {
+  nil -> case snd q of { nil -> true; _ -> false };
+  _ -> false
+};
+
+def empty := queue nil nil;
+
+def g := \q \acc if is_empty q then acc else g (pop_front q) (cons (front q) acc);
+def f := \n \q if n = 0 then g q nil else f (n - 1) (push_back q n);
+
+f 100 empty
diff --git a/tests/Core/positive/test029.jvc b/tests/Core/positive/test029.jvc
new file mode 100644
index 0000000000..658d5b0eb0
--- /dev/null
+++ b/tests/Core/positive/test029.jvc
@@ -0,0 +1 @@
+-- Church numerals
diff --git a/tests/Core/positive/test030.jvc b/tests/Core/positive/test030.jvc
new file mode 100644
index 0000000000..6f3ae7d6b1
--- /dev/null
+++ b/tests/Core/positive/test030.jvc
@@ -0,0 +1 @@
+-- streams
diff --git a/tests/Core/positive/test031.jvc b/tests/Core/positive/test031.jvc
new file mode 100644
index 0000000000..2d2dc72879
--- /dev/null
+++ b/tests/Core/positive/test031.jvc
@@ -0,0 +1 @@
+-- Ackermann function
diff --git a/tests/Core/positive/test032.jvc b/tests/Core/positive/test032.jvc
new file mode 100644
index 0000000000..b6b52e68b2
--- /dev/null
+++ b/tests/Core/positive/test032.jvc
@@ -0,0 +1 @@
+-- Ackermann function (higher-order definition)
diff --git a/tests/Core/positive/test033.jvc b/tests/Core/positive/test033.jvc
new file mode 100644
index 0000000000..f2599d28e4
--- /dev/null
+++ b/tests/Core/positive/test033.jvc
@@ -0,0 +1 @@
+-- nested lists
diff --git a/tests/Core/positive/test034.jvc b/tests/Core/positive/test034.jvc
new file mode 100644
index 0000000000..42a36c830e
--- /dev/null
+++ b/tests/Core/positive/test034.jvc
@@ -0,0 +1 @@
+-- evaluation order
diff --git a/tests/Core/positive/test035.jvc b/tests/Core/positive/test035.jvc
new file mode 100644
index 0000000000..db8a1e0685
--- /dev/null
+++ b/tests/Core/positive/test035.jvc
@@ -0,0 +1 @@
+-- merge sort
diff --git a/tests/Core/positive/test036.jvc b/tests/Core/positive/test036.jvc
new file mode 100644
index 0000000000..ca3ee384ea
--- /dev/null
+++ b/tests/Core/positive/test036.jvc
@@ -0,0 +1 @@
+-- big numbers
diff --git a/tests/Core/positive/test037.jvc b/tests/Core/positive/test037.jvc
new file mode 100644
index 0000000000..3cc9ea2844
--- /dev/null
+++ b/tests/Core/positive/test037.jvc
@@ -0,0 +1,11 @@
+-- global variables
+
+def x := 3 + 4;
+
+def f := \y x;
+
+def g := \y \z x;
+
+write (f nil) >>
+write (g nil nil) >>
+write "\n"
diff --git a/tests/Core/positive/test038.jvc b/tests/Core/positive/test038.jvc
new file mode 100644
index 0000000000..3c325c3bd3
--- /dev/null
+++ b/tests/Core/positive/test038.jvc
@@ -0,0 +1,11 @@
+-- global variables and forward declarations
+
+def x := (\x x) 5;
+
+def g;
+
+def f := \a \b g a + b;
+
+def g := \y x * y;
+
+f 2 3

From 26e453f0685630aa135f4871f12d2af283be8268 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Sun, 21 Aug 2022 10:00:42 +0200
Subject: [PATCH 68/85] minor changes

---
 src/Juvix/Compiler/Core/Evaluator.hs | 4 ----
 src/Juvix/Compiler/Core/Extra.hs     | 2 +-
 src/Juvix/Compiler/Core/Language.hs  | 2 --
 src/Juvix/Prelude/Base.hs            | 8 ++++++++
 4 files changed, 9 insertions(+), 7 deletions(-)

diff --git a/src/Juvix/Compiler/Core/Evaluator.hs b/src/Juvix/Compiler/Core/Evaluator.hs
index 764ed521e8..6f08de38ce 100644
--- a/src/Juvix/Compiler/Core/Evaluator.hs
+++ b/src/Juvix/Compiler/Core/Evaluator.hs
@@ -117,10 +117,6 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
         Just n' -> n'
         Nothing -> evalError "symbol not defined" n
 
-    revAppend :: [a] -> [a] -> [a]
-    revAppend [] ys = ys
-    revAppend (x : xs) ys = revAppend xs (x : ys)
-
 -- Evaluate `node` and interpret the builtin IO actions.
 evalIO :: IdentContext -> Env -> Node -> IO Node
 evalIO ctx env node =
diff --git a/src/Juvix/Compiler/Core/Extra.hs b/src/Juvix/Compiler/Core/Extra.hs
index c37fa2aff3..548cac801e 100644
--- a/src/Juvix/Compiler/Core/Extra.hs
+++ b/src/Juvix/Compiler/Core/Extra.hs
@@ -72,7 +72,7 @@ developBeta = umap go
       App _ (Lambda _ body) arg -> subst arg body
       _ -> n
 
--- substitution of all free variables for values in a closed environment
+-- substitution of all free variables for values in an environment
 substEnv :: Env -> Node -> Node
 substEnv env = if null env then id else umapN go
   where
diff --git a/src/Juvix/Compiler/Core/Language.hs b/src/Juvix/Compiler/Core/Language.hs
index bf679dff9a..0141154cf1 100644
--- a/src/Juvix/Compiler/Core/Language.hs
+++ b/src/Juvix/Compiler/Core/Language.hs
@@ -105,10 +105,8 @@ data CaseBranch = CaseBranch {caseTag :: !Tag, caseBindersNum :: !Int, caseBranc
 
 -- Values are closed nodes of the following kinds:
 -- - Constant
--- - Axiom
 -- - Data
 -- - Closure
--- - Suspended
 --
 -- Whether something is a value matters only for the evaluation semantics. It
 -- doesn't matter much outside the evaluator.
diff --git a/src/Juvix/Prelude/Base.hs b/src/Juvix/Prelude/Base.hs
index 608bd0fc26..d9d9dc4e95 100644
--- a/src/Juvix/Prelude/Base.hs
+++ b/src/Juvix/Prelude/Base.hs
@@ -218,6 +218,14 @@ tableNestedInsert ::
   HashMap k1 (HashMap k2 a)
 tableNestedInsert k1 k2 = tableInsert (HashMap.singleton k2) (HashMap.insert k2) k1
 
+--------------------------------------------------------------------------------
+-- List
+--------------------------------------------------------------------------------
+
+revAppend :: [a] -> [a] -> [a]
+revAppend [] !ys = ys
+revAppend (x : xs) !ys = revAppend xs (x : ys)
+
 --------------------------------------------------------------------------------
 -- NonEmpty
 --------------------------------------------------------------------------------

From b74eb6add60583b2f3f2209d2259769252bf711c Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Sun, 21 Aug 2022 11:43:24 +0200
Subject: [PATCH 69/85] Closure printing bugfix

---
 src/Juvix/Compiler/Core/Pretty/Base.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Juvix/Compiler/Core/Pretty/Base.hs b/src/Juvix/Compiler/Core/Pretty/Base.hs
index 87848b7a96..60e3d12b8d 100644
--- a/src/Juvix/Compiler/Core/Pretty/Base.hs
+++ b/src/Juvix/Compiler/Core/Pretty/Base.hs
@@ -146,7 +146,7 @@ instance PrettyCode Node where
       b2 <- ppCode ifFalseBranch
       return $ kwIf <+> v <+> kwThen <+> b1 <+> kwElse <+> b2
     Data {..} -> ppCode (ConstrApp dataInfo dataTag dataArgs)
-    Closure {..} -> ppCode (substEnv closureEnv closureBody)
+    Closure {..} -> ppCode (substEnv closureEnv (Lambda closureInfo closureBody))
 
 instance PrettyCode a => PrettyCode (NonEmpty a) where
   ppCode x = do

From 74a1c4f6f27ad51263f86a3149aa5e2b6e4055a5 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Sun, 21 Aug 2022 12:32:02 +0200
Subject: [PATCH 70/85] remove Data

---
 src/Juvix/Compiler/Core/Evaluator.hs            | 17 ++++++++---------
 src/Juvix/Compiler/Core/Extra.hs                | 10 +---------
 src/Juvix/Compiler/Core/Extra/Base.hs           |  4 +---
 src/Juvix/Compiler/Core/Language.hs             | 15 +++++----------
 src/Juvix/Compiler/Core/Pretty/Base.hs          |  3 +--
 src/Juvix/Compiler/Core/Transformation/Eta.hs   |  4 ++--
 .../Compiler/Core/Translation/FromSource.hs     |  6 +++---
 7 files changed, 21 insertions(+), 38 deletions(-)

diff --git a/src/Juvix/Compiler/Core/Evaluator.hs b/src/Juvix/Compiler/Core/Evaluator.hs
index 6f08de38ce..5bf8f67ac2 100644
--- a/src/Juvix/Compiler/Core/Evaluator.hs
+++ b/src/Juvix/Compiler/Core/Evaluator.hs
@@ -60,19 +60,18 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
           Closure _ env' b -> let !v = eval' env r in eval' (v : env') b
           v -> evalError "invalid application" (App i v (substEnv env r))
       BuiltinApp _ op args -> applyBuiltin n env op args
-      ConstrApp i tag args -> Data i tag (map (eval' env) args)
+      Constr i tag args -> Constr i tag (map (eval' env) args)
       Lambda i b -> Closure i env b
       Let _ v b -> let !v' = eval' env v in eval' (v' : env) b
       Case i v bs def ->
         case eval' env v of
-          Data _ tag args -> branch n env args tag def bs
+          Constr _ tag args -> branch n env args tag def bs
           v' -> evalError "matching on non-data" (substEnv env (Case i v' bs def))
       If i v b1 b2 ->
         case eval' env v of
           Constant _ (ConstBool True) -> eval' env b1
           Constant _ (ConstBool False) -> eval' env b2
           v' -> evalError "conditional branch on a non-boolean" (substEnv env (If i v' b1 b2))
-      Data {} -> n
       Closure {} -> n
 
     branch :: Node -> Env -> [Node] -> Tag -> Maybe Node -> [CaseBranch] -> Node
@@ -122,24 +121,24 @@ evalIO :: IdentContext -> Env -> Node -> IO Node
 evalIO ctx env node =
   let node' = eval ctx env node
    in case node' of
-        ConstrApp _ (BuiltinTag TagReturn) [x] ->
+        Constr _ (BuiltinTag TagReturn) [x] ->
           return x
-        ConstrApp _ (BuiltinTag TagBind) [x, f] -> do
+        Constr _ (BuiltinTag TagBind) [x, f] -> do
           x' <- evalIO ctx env x
           evalIO ctx env (App Info.empty f x')
-        ConstrApp _ (BuiltinTag TagWrite) [Constant _ (ConstString s)] -> do
+        Constr _ (BuiltinTag TagWrite) [Constant _ (ConstString s)] -> do
           putStr s
           return unitNode
-        ConstrApp _ (BuiltinTag TagWrite) [arg] -> do
+        Constr _ (BuiltinTag TagWrite) [arg] -> do
           putStr (ppPrint arg)
           return unitNode
-        ConstrApp _ (BuiltinTag TagReadLn) [] -> do
+        Constr _ (BuiltinTag TagReadLn) [] -> do
           hFlush stdout
           Constant Info.empty . ConstString <$> getLine
         _ ->
           return node'
   where
-    unitNode = ConstrApp (Info.singleton (NoDisplayInfo ())) (BuiltinTag TagNil) []
+    unitNode = Constr (Info.singleton (NoDisplayInfo ())) (BuiltinTag TagNil) []
 
 -- Catch EvalError and convert it to CoreError. Needs a default location in case
 -- no location is available in EvalError.
diff --git a/src/Juvix/Compiler/Core/Extra.hs b/src/Juvix/Compiler/Core/Extra.hs
index 548cac801e..8d725da6cd 100644
--- a/src/Juvix/Compiler/Core/Extra.hs
+++ b/src/Juvix/Compiler/Core/Extra.hs
@@ -88,13 +88,5 @@ convertClosures = umap go
       Closure i env b -> substEnv env (Lambda i b)
       _ -> n
 
-convertData :: Node -> Node
-convertData = umap go
-  where
-    go :: Node -> Node
-    go n = case n of
-      Data i tag args -> ConstrApp i tag args
-      _ -> n
-
 convertRuntimeNodes :: Node -> Node
-convertRuntimeNodes = convertData . convertClosures
+convertRuntimeNodes = convertClosures
diff --git a/src/Juvix/Compiler/Core/Extra/Base.hs b/src/Juvix/Compiler/Core/Extra/Base.hs
index 00ebb5e5bf..625a3adaa1 100644
--- a/src/Juvix/Compiler/Core/Extra/Base.hs
+++ b/src/Juvix/Compiler/Core/Extra/Base.hs
@@ -92,7 +92,7 @@ destruct = \case
   Constant i c -> NodeDetails i [] [] [] (\i' _ -> Constant i' c)
   App i l r -> NodeDetails i [l, r] [0, 0] [Nothing, Nothing] (\i' args' -> App i' (hd args') (args' !! 1))
   BuiltinApp i op args -> NodeDetails i args (map (const 0) args) (map (const Nothing) args) (`BuiltinApp` op)
-  ConstrApp i tag args -> NodeDetails i args (map (const 0) args) (map (const Nothing) args) (`ConstrApp` tag)
+  Constr i tag args -> NodeDetails i args (map (const 0) args) (map (const Nothing) args) (`Constr` tag)
   Lambda i b -> NodeDetails i [b] [1] [fetchBinderInfo i] (\i' args' -> Lambda i' (hd args'))
   Let i v b -> NodeDetails i [v, b] [0, 1] [Nothing, fetchBinderInfo i] (\i' args' -> Let i' (hd args') (args' !! 1))
   Case i v bs Nothing ->
@@ -136,8 +136,6 @@ destruct = \case
       [0, 0, 0]
       [Nothing, Nothing, Nothing]
       (\i' args' -> If i' (hd args') (args' !! 1) (args' !! 2))
-  Data i tag args ->
-    NodeDetails i args (map (const 0) args) (map (const Nothing) args) (`Data` tag)
   Closure i env b ->
     NodeDetails
       i
diff --git a/src/Juvix/Compiler/Core/Language.hs b/src/Juvix/Compiler/Core/Language.hs
index 0141154cf1..2a06e40b4a 100644
--- a/src/Juvix/Compiler/Core/Language.hs
+++ b/src/Juvix/Compiler/Core/Language.hs
@@ -40,7 +40,7 @@ data Node
     BuiltinApp {builtinInfo :: !Info, builtinOp :: !BuiltinOp, builtinArgs :: ![Node]}
   | -- A data constructor application. The number of arguments supplied must be
     -- equal to the number of arguments expected by the constructor.
-    ConstrApp
+    Constr
       { constrInfo :: !Info,
         constrTag :: !Tag,
         constrArgs :: ![Node]
@@ -65,9 +65,6 @@ data Node
         ifTrueBranch :: !Node,
         ifFalseBranch :: !Node
       }
-  | -- Evaluation only: evaluated data constructor (the actual data). Arguments
-    -- order: left to right. Arguments are values (see below).
-    Data {dataInfo :: !Info, dataTag :: !Tag, dataArgs :: ![Node]}
   | -- Evaluation only: `Closure env body`
     Closure
       { closureInfo :: !Info,
@@ -105,7 +102,7 @@ data CaseBranch = CaseBranch {caseTag :: !Tag, caseBindersNum :: !Int, caseBranc
 
 -- Values are closed nodes of the following kinds:
 -- - Constant
--- - Data
+-- - Constr if all arguments are values
 -- - Closure
 --
 -- Whether something is a value matters only for the evaluation semantics. It
@@ -122,13 +119,12 @@ instance HasAtomicity Node where
     App {} -> Aggregate appFixity
     BuiltinApp {..} | null builtinArgs -> Atom
     BuiltinApp {} -> Aggregate lambdaFixity
-    ConstrApp {..} | null constrArgs -> Atom
-    ConstrApp {} -> Aggregate lambdaFixity
+    Constr {..} | null constrArgs -> Atom
+    Constr {} -> Aggregate lambdaFixity
     Lambda {} -> Aggregate lambdaFixity
     Let {} -> Aggregate lambdaFixity
     Case {} -> Aggregate lambdaFixity
     If {} -> Aggregate lambdaFixity
-    Data {} -> Aggregate lambdaFixity
     Closure {} -> Aggregate lambdaFixity
 
 lambdaFixity :: Fixity
@@ -141,11 +137,10 @@ instance Eq Node where
   Constant _ v1 == Constant _ v2 = v1 == v2
   App _ l1 r1 == App _ l2 r2 = l1 == l2 && r1 == r2
   BuiltinApp _ op1 args1 == BuiltinApp _ op2 args2 = op1 == op2 && args1 == args2
-  ConstrApp _ tag1 args1 == ConstrApp _ tag2 args2 = tag1 == tag2 && args1 == args2
+  Constr _ tag1 args1 == Constr _ tag2 args2 = tag1 == tag2 && args1 == args2
   Lambda _ b1 == Lambda _ b2 = b1 == b2
   Let _ v1 b1 == Let _ v2 b2 = v1 == v2 && b1 == b2
   Case _ v1 bs1 def1 == Case _ v2 bs2 def2 = v1 == v2 && bs1 == bs2 && def1 == def2
   If _ v1 tb1 fb1 == If _ v2 tb2 fb2 = v1 == v2 && tb1 == tb2 && fb1 == fb2
-  Data _ tag1 args1 == Data _ tag2 args2 = tag1 == tag2 && args1 == args2
   Closure _ env1 b1 == Closure _ env2 b2 = env1 == env2 && b1 == b2
   _ == _ = False
diff --git a/src/Juvix/Compiler/Core/Pretty/Base.hs b/src/Juvix/Compiler/Core/Pretty/Base.hs
index 60e3d12b8d..9d235ad6cf 100644
--- a/src/Juvix/Compiler/Core/Pretty/Base.hs
+++ b/src/Juvix/Compiler/Core/Pretty/Base.hs
@@ -92,7 +92,7 @@ instance PrettyCode Node where
       args' <- mapM (ppRightExpression appFixity) builtinArgs
       op' <- ppCode builtinOp
       return $ foldl (<+>) op' args'
-    ConstrApp {..} -> do
+    Constr {..} -> do
       args' <- mapM (ppRightExpression appFixity) constrArgs
       n' <-
         case Info.lookup kNameInfo constrInfo of
@@ -145,7 +145,6 @@ instance PrettyCode Node where
       b1 <- ppCode ifTrueBranch
       b2 <- ppCode ifFalseBranch
       return $ kwIf <+> v <+> kwThen <+> b1 <+> kwElse <+> b2
-    Data {..} -> ppCode (ConstrApp dataInfo dataTag dataArgs)
     Closure {..} -> ppCode (substEnv closureEnv (Lambda closureInfo closureBody))
 
 instance PrettyCode a => PrettyCode (NonEmpty a) where
diff --git a/src/Juvix/Compiler/Core/Transformation/Eta.hs b/src/Juvix/Compiler/Core/Transformation/Eta.hs
index 23b25461d6..a8e76fc0cf 100644
--- a/src/Juvix/Compiler/Core/Transformation/Eta.hs
+++ b/src/Juvix/Compiler/Core/Transformation/Eta.hs
@@ -23,7 +23,7 @@ etaExpandConstrs argsNum = umap go
   where
     go :: Node -> Node
     go n = case n of
-      ConstrApp {..}
+      Constr {..}
         | k > length constrArgs ->
             etaExpand (k - length constrArgs) n
         where
@@ -37,7 +37,7 @@ squashApps = dmap go
     go n =
       let (l, args) = unfoldApp n
        in case l of
-            ConstrApp i tag args' -> ConstrApp i tag (args' ++ args)
+            Constr i tag args' -> Constr i tag (args' ++ args)
             BuiltinApp i op args' -> BuiltinApp i op (args' ++ args)
             _ -> n
 
diff --git a/src/Juvix/Compiler/Core/Translation/FromSource.hs b/src/Juvix/Compiler/Core/Translation/FromSource.hs
index c85108cffc..676db46272 100644
--- a/src/Juvix/Compiler/Core/Translation/FromSource.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromSource.hs
@@ -229,7 +229,7 @@ bindExpr' ::
 bindExpr' varsNum vars node = do
   kwBind
   node' <- cmpExpr varsNum vars
-  ioExpr' varsNum vars (ConstrApp Info.empty (BuiltinTag TagBind) [node, node'])
+  ioExpr' varsNum vars (Constr Info.empty (BuiltinTag TagBind) [node, node'])
 
 seqExpr' ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
@@ -242,7 +242,7 @@ seqExpr' varsNum vars node = do
   node' <- cmpExpr (varsNum + 1) vars
   name <- lift $ freshName KNameLocal "_" i
   ioExpr' varsNum vars $
-    ConstrApp
+    Constr
       Info.empty
       (BuiltinTag TagBind)
       [node, Lambda (Info.singleton (BinderInfo name (TyVar 0))) node']
@@ -485,7 +485,7 @@ exprNamed varsNum vars = do
           return $ Ident (Info.singleton (NameInfo name)) sym
         Just (Right tag) -> do
           name <- lift $ freshName KNameConstructor txt i
-          return $ ConstrApp (Info.singleton (NameInfo name)) tag []
+          return $ Constr (Info.singleton (NameInfo name)) tag []
         Nothing ->
           parseFailure off ("undeclared identifier: " ++ fromText txt)
 

From ef5047036da7f9b5e2d4d1b872e7eca42dda44bf Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Sun, 21 Aug 2022 17:58:55 +0200
Subject: [PATCH 71/85] Pi node

---
 src/Juvix/Compiler/Core/Data/InfoTable.hs     |  1 -
 src/Juvix/Compiler/Core/Evaluator.hs          |  3 +++
 src/Juvix/Compiler/Core/Extra/Base.hs         | 22 ++++++++---------
 src/Juvix/Compiler/Core/Language.hs           | 20 +++++++++++-----
 .../Compiler/Core/Language/Info/BinderInfo.hs |  3 +--
 .../Compiler/Core/Language/Info/TypeInfo.hs   |  3 +--
 src/Juvix/Compiler/Core/Language/Type.hs      | 16 -------------
 src/Juvix/Compiler/Core/Pretty/Base.hs        | 24 ++++++++++++++++++-
 .../Compiler/Core/Translation/FromSource.hs   | 18 +++++++-------
 src/Juvix/Extra/Strings.hs                    |  3 +++
 10 files changed, 66 insertions(+), 47 deletions(-)
 delete mode 100644 src/Juvix/Compiler/Core/Language/Type.hs

diff --git a/src/Juvix/Compiler/Core/Data/InfoTable.hs b/src/Juvix/Compiler/Core/Data/InfoTable.hs
index 4e5e91f15a..bf9751276a 100644
--- a/src/Juvix/Compiler/Core/Data/InfoTable.hs
+++ b/src/Juvix/Compiler/Core/Data/InfoTable.hs
@@ -1,7 +1,6 @@
 module Juvix.Compiler.Core.Data.InfoTable where
 
 import Juvix.Compiler.Core.Language
-import Juvix.Compiler.Core.Language.Type
 
 type IdentContext = HashMap Symbol Node
 
diff --git a/src/Juvix/Compiler/Core/Evaluator.hs b/src/Juvix/Compiler/Core/Evaluator.hs
index 5bf8f67ac2..f1b03b953d 100644
--- a/src/Juvix/Compiler/Core/Evaluator.hs
+++ b/src/Juvix/Compiler/Core/Evaluator.hs
@@ -72,6 +72,9 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
           Constant _ (ConstBool True) -> eval' env b1
           Constant _ (ConstBool False) -> eval' env b2
           v' -> evalError "conditional branch on a non-boolean" (substEnv env (If i v' b1 b2))
+      Pi {} -> substEnv env n -- this might need to be implemented more efficiently
+      Univ {} -> n
+      TypeApp i sym args -> TypeApp i sym (map (eval' env) args)
       Closure {} -> n
 
     branch :: Node -> Env -> [Node] -> Tag -> Maybe Node -> [CaseBranch] -> Node
diff --git a/src/Juvix/Compiler/Core/Extra/Base.hs b/src/Juvix/Compiler/Core/Extra/Base.hs
index 625a3adaa1..8125d31c43 100644
--- a/src/Juvix/Compiler/Core/Extra/Base.hs
+++ b/src/Juvix/Compiler/Core/Extra/Base.hs
@@ -5,23 +5,16 @@ import Data.List qualified as List
 import Juvix.Compiler.Core.Language
 import Juvix.Compiler.Core.Language.Info qualified as Info
 import Juvix.Compiler.Core.Language.Info.BinderInfo
-import Juvix.Compiler.Core.Language.Type
 
 {------------------------------------------------------------------------}
 {- functions on Type -}
 
 -- unfold a type into the target and the arguments (left-to-right)
-unfoldType :: Type -> (Type, [Type])
-unfoldType ty = case ty of
-  Fun l r -> let (tgt, args) = unfoldType r in (tgt, l : args)
+unfoldType' :: Type -> (Type, [(Info, Type)])
+unfoldType' ty = case ty of
+  Pi i l r -> let (tgt, args) = unfoldType' r in (tgt, (i, l) : args)
   _ -> (ty, [])
 
-getTarget :: Type -> Type
-getTarget = fst . unfoldType
-
-getArgs :: Type -> [Type]
-getArgs = snd . unfoldType
-
 {------------------------------------------------------------------------}
 {- functions on Node -}
 
@@ -84,7 +77,8 @@ data NodeDetails = NodeDetails
 
 makeLenses ''NodeDetails
 
--- destruct a node into NodeDetails
+-- Destruct a node into NodeDetails. This is an ugly internal function used to
+-- implement more high-level accessors and recursors.
 destruct :: Node -> NodeDetails
 destruct = \case
   Var i idx -> NodeDetails i [] [] [] (\i' _ -> Var i' idx)
@@ -136,6 +130,12 @@ destruct = \case
       [0, 0, 0]
       [Nothing, Nothing, Nothing]
       (\i' args' -> If i' (hd args') (args' !! 1) (args' !! 2))
+  Pi i ty b ->
+    NodeDetails i [ty, b] [0, 1] [Nothing, fetchBinderInfo i] (\i' args' -> Pi i' (hd args') (args' !! 1))
+  Univ i l ->
+    NodeDetails i [] [] [] (\i' _ -> Univ i' l)
+  TypeApp i sym args ->
+    NodeDetails i args (map (const 0) args) (map (const Nothing) args) (`TypeApp` sym)
   Closure i env b ->
     NodeDetails
       i
diff --git a/src/Juvix/Compiler/Core/Language.hs b/src/Juvix/Compiler/Core/Language.hs
index 2a06e40b4a..bf059eae83 100644
--- a/src/Juvix/Compiler/Core/Language.hs
+++ b/src/Juvix/Compiler/Core/Language.hs
@@ -65,6 +65,12 @@ data Node
         ifTrueBranch :: !Node,
         ifFalseBranch :: !Node
       }
+  | -- Dependent Pi-type. Compilation-time only.
+    Pi {piInfo :: !Info, piType :: !Type, piBody :: !Type}
+  | -- Universe. Compilation-time only.
+    Univ {univInfo :: !Info, univLevel :: !Int}
+  | -- Type application. Compilation-time only.
+    TypeApp {typeInfo :: !Info, typeSymbol :: !Symbol, typeArgs :: ![Node]}
   | -- Evaluation only: `Closure env body`
     Closure
       { closureInfo :: !Info,
@@ -75,12 +81,6 @@ data Node
 -- Other things we might need in the future:
 -- - laziness annotations (converting these to closure/thunk creation should be
 --   done further down the pipeline)
--- - with dependent types, it might actually be more reasonable to have Pi as
---   another node (because it's a binder); computationally it would be a unit,
---   erased in further stages of the pipeline
--- - with Pi a node, other basic type constructors should also be nodes:
---   TypeIdent (named type identifier available in the global context, e.g.,
---   inductive type), Universe
 
 data ConstantValue
   = ConstInteger !Integer
@@ -111,6 +111,8 @@ data CaseBranch = CaseBranch {caseTag :: !Tag, caseBindersNum :: !Int, caseBranc
 -- All nodes in an environment must be values.
 type Env = [Node]
 
+type Type = Node
+
 instance HasAtomicity Node where
   atomicity = \case
     Var {} -> Atom
@@ -125,6 +127,9 @@ instance HasAtomicity Node where
     Let {} -> Aggregate lambdaFixity
     Case {} -> Aggregate lambdaFixity
     If {} -> Aggregate lambdaFixity
+    Pi {} -> Aggregate lambdaFixity
+    Univ {} -> Atom
+    TypeApp {} -> Aggregate appFixity
     Closure {} -> Aggregate lambdaFixity
 
 lambdaFixity :: Fixity
@@ -142,5 +147,8 @@ instance Eq Node where
   Let _ v1 b1 == Let _ v2 b2 = v1 == v2 && b1 == b2
   Case _ v1 bs1 def1 == Case _ v2 bs2 def2 = v1 == v2 && bs1 == bs2 && def1 == def2
   If _ v1 tb1 fb1 == If _ v2 tb2 fb2 = v1 == v2 && tb1 == tb2 && fb1 == fb2
+  Pi _ ty1 b1 == Pi _ ty2 b2 = ty1 == ty2 && b1 == b2
+  Univ _ l1 == Univ _ l2 = l1 == l2
+  TypeApp _ sym1 args1 == TypeApp _ sym2 args2 = sym1 == sym2 && args1 == args2
   Closure _ env1 b1 == Closure _ env2 b2 = env1 == env2 && b1 == b2
   _ == _ = False
diff --git a/src/Juvix/Compiler/Core/Language/Info/BinderInfo.hs b/src/Juvix/Compiler/Core/Language/Info/BinderInfo.hs
index 2810d177b3..084e47c3de 100644
--- a/src/Juvix/Compiler/Core/Language/Info/BinderInfo.hs
+++ b/src/Juvix/Compiler/Core/Language/Info/BinderInfo.hs
@@ -1,7 +1,6 @@
 module Juvix.Compiler.Core.Language.Info.BinderInfo where
 
-import Juvix.Compiler.Core.Language.Base
-import Juvix.Compiler.Core.Language.Type
+import Juvix.Compiler.Core.Language
 
 data BinderInfo = BinderInfo
   { _infoName :: Name,
diff --git a/src/Juvix/Compiler/Core/Language/Info/TypeInfo.hs b/src/Juvix/Compiler/Core/Language/Info/TypeInfo.hs
index 4d4b54683f..3032a3985f 100644
--- a/src/Juvix/Compiler/Core/Language/Info/TypeInfo.hs
+++ b/src/Juvix/Compiler/Core/Language/Info/TypeInfo.hs
@@ -1,7 +1,6 @@
 module Juvix.Compiler.Core.Language.Info.TypeInfo where
 
-import Juvix.Compiler.Core.Language.Base
-import Juvix.Compiler.Core.Language.Type
+import Juvix.Compiler.Core.Language
 
 newtype TypeInfo = TypeInfo {_infoType :: Type}
 
diff --git a/src/Juvix/Compiler/Core/Language/Type.hs b/src/Juvix/Compiler/Core/Language/Type.hs
deleted file mode 100644
index 9bd056f4ac..0000000000
--- a/src/Juvix/Compiler/Core/Language/Type.hs
+++ /dev/null
@@ -1,16 +0,0 @@
-module Juvix.Compiler.Core.Language.Type where
-
-import Juvix.Compiler.Core.Language.Base
-
-{-
-- TyVar indicates a polymorphic type variable
-- Atomic indicates an atom: e.g. an inductive type applied to type arguments
--}
-data Type = TyVar Int | Universe Int | Atomic Atom | Fun Type Type
-
-data Atom = Atom
-  { _atomHead :: Name,
-    _atomArgs :: [Type]
-  }
-
-makeLenses ''Atom
diff --git a/src/Juvix/Compiler/Core/Pretty/Base.hs b/src/Juvix/Compiler/Core/Pretty/Base.hs
index 9d235ad6cf..03a853368f 100644
--- a/src/Juvix/Compiler/Core/Pretty/Base.hs
+++ b/src/Juvix/Compiler/Core/Pretty/Base.hs
@@ -145,7 +145,26 @@ instance PrettyCode Node where
       b1 <- ppCode ifTrueBranch
       b2 <- ppCode ifFalseBranch
       return $ kwIf <+> v <+> kwThen <+> b1 <+> kwElse <+> b2
-    Closure {..} -> ppCode (substEnv closureEnv (Lambda closureInfo closureBody))
+    Pi {..} ->
+      case Info.lookup kBinderInfo piInfo of
+        Just bi -> do
+          n <- ppCode (bi ^. BinderInfo.infoName)
+          b <- ppCode piBody
+          return $ kwLambda <> n <+> b
+        Nothing -> do
+          b <- ppCode piBody
+          return $ kwLambda <> kwQuestion <+> b
+    Univ {..} ->
+      return $ kwType <+> pretty univLevel
+    TypeApp {..} -> do
+      args' <- mapM (ppRightExpression appFixity) typeArgs
+      n' <-
+        case Info.lookup kNameInfo typeInfo of
+          Just ni -> ppCode (ni ^. NameInfo.infoName)
+          Nothing -> return $ kwUnnamedIdent <> pretty typeSymbol
+      return $ foldl (<+>) n' args'
+    Closure {..} ->
+      ppCode (substEnv closureEnv (Lambda closureInfo closureBody))
 
 instance PrettyCode a => PrettyCode (NonEmpty a) where
   ppCode x = do
@@ -242,3 +261,6 @@ kwThen = keyword Str.then_
 
 kwElse :: Doc Ann
 kwElse = keyword Str.else_
+
+kwPi :: Doc Ann
+kwPi = keyword Str.pi_
diff --git a/src/Juvix/Compiler/Core/Translation/FromSource.hs b/src/Juvix/Compiler/Core/Translation/FromSource.hs
index 676db46272..7520c1e61d 100644
--- a/src/Juvix/Compiler/Core/Translation/FromSource.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromSource.hs
@@ -12,7 +12,6 @@ import Juvix.Compiler.Core.Language.Info.BinderInfo as BinderInfo
 import Juvix.Compiler.Core.Language.Info.BranchInfo as BranchInfo
 import Juvix.Compiler.Core.Language.Info.LocationInfo as LocationInfo
 import Juvix.Compiler.Core.Language.Info.NameInfo as NameInfo
-import Juvix.Compiler.Core.Language.Type
 import Juvix.Compiler.Core.Transformation.Eta
 import Juvix.Compiler.Core.Translation.FromSource.Lexer
 import Juvix.Parser.Error
@@ -39,6 +38,9 @@ runParser root fileName tab input =
         { _parserParamsRoot = root
         }
 
+starType :: Type
+starType = Pi Info.empty (Univ Info.empty 0) (Var Info.empty 0)
+
 freshName ::
   Members '[InfoTableBuilder, NameIdGen] r =>
   NameKind ->
@@ -68,7 +70,7 @@ declareBuiltinConstr btag nameTxt i = do
     ( ConstructorInfo
         { _constructorName = name,
           _constructorTag = BuiltinTag btag,
-          _constructorType = TyVar 0,
+          _constructorType = starType,
           _constructorArgsNum = builtinConstrArgsNum btag
         }
     )
@@ -132,7 +134,7 @@ statementDef = do
             IdentInfo
               { _identName = name,
                 _identSymbol = sym,
-                _identType = TyVar 0,
+                _identType = starType,
                 _identArgsNum = 0,
                 _identArgsInfo = [],
                 _identIsExported = False
@@ -180,7 +182,7 @@ statementConstr = do
         ConstructorInfo
           { _constructorName = name,
             _constructorTag = tag,
-            _constructorType = TyVar 0,
+            _constructorType = starType,
             _constructorArgsNum = argsNum
           }
   lift $ registerConstructor info
@@ -245,7 +247,7 @@ seqExpr' varsNum vars node = do
     Constr
       Info.empty
       (BuiltinTag TagBind)
-      [node, Lambda (Info.singleton (BinderInfo name (TyVar 0))) node']
+      [node, Lambda (Info.singleton (BinderInfo name starType)) node']
 
 cmpExpr ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
@@ -536,7 +538,7 @@ exprLambda varsNum vars = do
   name <- parseLocalName
   let vars' = HashMap.insert (name ^. nameText) varsNum vars
   body <- expr (varsNum + 1) vars'
-  return $ Lambda (Info.singleton (BinderInfo name (TyVar 0))) body
+  return $ Lambda (Info.singleton (BinderInfo name starType)) body
 
 exprLet ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
@@ -551,7 +553,7 @@ exprLet varsNum vars = do
   kwIn
   let vars' = HashMap.insert (name ^. nameText) varsNum vars
   body <- expr (varsNum + 1) vars'
-  return $ Let (Info.singleton (BinderInfo name (TyVar 0))) value body
+  return $ Let (Info.singleton (BinderInfo name starType)) value body
 
 exprCase ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
@@ -579,7 +581,7 @@ exprCase' off value varsNum vars = do
   let bss = map fst bs'
   let bsns = map snd bs'
   let def' = map fromRight' $ filter isRight bs
-  let bi = CaseBinderInfo $ map (map (`BinderInfo` TyVar 0)) bsns
+  let bi = CaseBinderInfo $ map (map (`BinderInfo` starType)) bsns
   bri <-
     CaseBranchInfo
       <$> mapM
diff --git a/src/Juvix/Extra/Strings.hs b/src/Juvix/Extra/Strings.hs
index f0e2f1c868..d29455ef3d 100644
--- a/src/Juvix/Extra/Strings.hs
+++ b/src/Juvix/Extra/Strings.hs
@@ -296,6 +296,9 @@ then_ = "then"
 else_ :: IsString s => s
 else_ = "else"
 
+pi_ :: IsString s => s
+pi_ = "pi"
+
 def :: IsString s => s
 def = "def"
 

From 259815b29b745aa8b1754639cd196af9a657fd1b Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Sun, 21 Aug 2022 20:58:11 +0200
Subject: [PATCH 72/85] minor

---
 src/Juvix/Compiler/Core/Evaluator.hs | 2 +-
 src/Juvix/Compiler/Core/Language.hs  | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Juvix/Compiler/Core/Evaluator.hs b/src/Juvix/Compiler/Core/Evaluator.hs
index f1b03b953d..1dc0bb3794 100644
--- a/src/Juvix/Compiler/Core/Evaluator.hs
+++ b/src/Juvix/Compiler/Core/Evaluator.hs
@@ -72,7 +72,7 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
           Constant _ (ConstBool True) -> eval' env b1
           Constant _ (ConstBool False) -> eval' env b2
           v' -> evalError "conditional branch on a non-boolean" (substEnv env (If i v' b1 b2))
-      Pi {} -> substEnv env n -- this might need to be implemented more efficiently
+      Pi {} -> substEnv env n -- this might need to be implemented more efficiently later
       Univ {} -> n
       TypeApp i sym args -> TypeApp i sym (map (eval' env) args)
       Closure {} -> n
diff --git a/src/Juvix/Compiler/Core/Language.hs b/src/Juvix/Compiler/Core/Language.hs
index bf059eae83..7325fca141 100644
--- a/src/Juvix/Compiler/Core/Language.hs
+++ b/src/Juvix/Compiler/Core/Language.hs
@@ -70,7 +70,7 @@ data Node
   | -- Universe. Compilation-time only.
     Univ {univInfo :: !Info, univLevel :: !Int}
   | -- Type application. Compilation-time only.
-    TypeApp {typeInfo :: !Info, typeSymbol :: !Symbol, typeArgs :: ![Node]}
+    TypeApp {typeInfo :: !Info, typeSymbol :: !Symbol, typeArgs :: ![Type]}
   | -- Evaluation only: `Closure env body`
     Closure
       { closureInfo :: !Info,

From 3272d0312b2198982bfb6f89e56677508032b9fa Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Mon, 22 Aug 2022 16:21:32 +0200
Subject: [PATCH 73/85] eta-expansion bugfix

---
 src/Juvix/Compiler/Core/Extra.hs      | 6 ++++++
 src/Juvix/Compiler/Core/Extra/Base.hs | 3 ---
 2 files changed, 6 insertions(+), 3 deletions(-)

diff --git a/src/Juvix/Compiler/Core/Extra.hs b/src/Juvix/Compiler/Core/Extra.hs
index 8d725da6cd..1cdc815a8e 100644
--- a/src/Juvix/Compiler/Core/Extra.hs
+++ b/src/Juvix/Compiler/Core/Extra.hs
@@ -11,6 +11,7 @@ import Juvix.Compiler.Core.Extra.Base
 import Juvix.Compiler.Core.Extra.Info
 import Juvix.Compiler.Core.Extra.Recursors
 import Juvix.Compiler.Core.Language
+import Juvix.Compiler.Core.Language.Info qualified as Info
 
 -- `isClosed` may short-circuit evaluation due to the use of `&&`, so it's not
 -- entirely reducible to `getFreeVars` in terms of computation time.
@@ -47,6 +48,7 @@ countFreeVarOccurrences idx = gatherN go 0
 
 -- increase all free variable indices by a given value
 shift :: Index -> Node -> Node
+shift 0 = id
 shift m = umapN go
   where
     go k n = case n of
@@ -72,6 +74,10 @@ developBeta = umap go
       App _ (Lambda _ body) arg -> subst arg body
       _ -> n
 
+etaExpand :: Int -> Node -> Node
+etaExpand 0 n = n
+etaExpand k n = mkLambdas k (mkApp (shift k n) (map (Var Info.empty) (reverse [0 .. k - 1])))
+
 -- substitution of all free variables for values in an environment
 substEnv :: Env -> Node -> Node
 substEnv env = if null env then id else umapN go
diff --git a/src/Juvix/Compiler/Core/Extra/Base.hs b/src/Juvix/Compiler/Core/Extra/Base.hs
index 8125d31c43..b88cd1579c 100644
--- a/src/Juvix/Compiler/Core/Extra/Base.hs
+++ b/src/Juvix/Compiler/Core/Extra/Base.hs
@@ -52,9 +52,6 @@ unfoldLambdas' = go []
 unfoldLambdas :: Node -> (Int, Node)
 unfoldLambdas = first length . unfoldLambdas'
 
-etaExpand :: Int -> Node -> Node
-etaExpand k n = mkLambdas k (mkApp n (map (Var Info.empty) (reverse [0 .. k - 1])))
-
 -- `NodeDetails` is a convenience datatype which provides the most commonly needed
 -- information about a node in a generic fashion.
 data NodeDetails = NodeDetails

From b146d0e9e071fed42b5ab0b85dd2eafbf0ae4568 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Mon, 22 Aug 2022 17:32:24 +0200
Subject: [PATCH 74/85] Positive evaluator tests

---
 src/Juvix/Compiler/Core/Evaluator.hs          |  19 +-
 .../Compiler/Core/Translation/FromSource.hs   |   6 +-
 test/Core.hs                                  |   7 +
 test/Core/Base.hs                             |  63 +++++
 test/Core/Positive.hs                         | 227 ++++++++++++++++++
 test/Main.hs                                  |   5 +-
 tests/Core/benchmark/out/test004.out          |   4 +
 tests/Core/benchmark/test004.jvc              |  34 +++
 tests/Core/positive/out/test009.out           |   1 +
 tests/Core/positive/out/test028.out           |   1 +
 tests/Core/positive/out/test029.out           |   7 +
 tests/Core/positive/out/test030.out           |   3 +
 tests/Core/positive/out/test031.out           |   6 +
 tests/Core/positive/out/test032.out           |   4 +
 tests/Core/positive/out/test033.out           |   2 +
 tests/Core/positive/out/test035.out           |   3 +
 tests/Core/positive/out/test036.out           |  51 ++++
 tests/Core/positive/out/test039.out           |   4 +
 tests/Core/positive/reference/test030.hs      |   8 +
 tests/Core/positive/test009.jvc               |  31 +--
 tests/Core/positive/test011.jvc               |  14 --
 tests/Core/positive/test015.jvc               |   2 +-
 tests/Core/positive/test021.jvc               |   2 +-
 tests/Core/positive/test028.jvc               |   7 +-
 tests/Core/positive/test029.jvc               |  55 +++++
 tests/Core/positive/test030.jvc               |  42 +++-
 tests/Core/positive/test031.jvc               |  17 ++
 tests/Core/positive/test032.jvc               |  24 ++
 tests/Core/positive/test033.jvc               |  18 ++
 tests/Core/positive/test035.jvc               |  79 ++++++
 tests/Core/positive/test036.jvc               |  99 ++++++++
 tests/Core/positive/test039.jvc               |  20 ++
 32 files changed, 809 insertions(+), 56 deletions(-)
 create mode 100644 test/Core.hs
 create mode 100644 test/Core/Base.hs
 create mode 100644 test/Core/Positive.hs
 create mode 100644 tests/Core/benchmark/out/test004.out
 create mode 100644 tests/Core/benchmark/test004.jvc
 create mode 100644 tests/Core/positive/out/test028.out
 create mode 100644 tests/Core/positive/out/test029.out
 create mode 100644 tests/Core/positive/out/test030.out
 create mode 100644 tests/Core/positive/out/test031.out
 create mode 100644 tests/Core/positive/out/test032.out
 create mode 100644 tests/Core/positive/out/test033.out
 create mode 100644 tests/Core/positive/out/test035.out
 create mode 100644 tests/Core/positive/out/test036.out
 create mode 100644 tests/Core/positive/out/test039.out
 create mode 100644 tests/Core/positive/reference/test030.hs
 create mode 100644 tests/Core/positive/test039.jvc

diff --git a/src/Juvix/Compiler/Core/Evaluator.hs b/src/Juvix/Compiler/Core/Evaluator.hs
index 1dc0bb3794..fba484c967 100644
--- a/src/Juvix/Compiler/Core/Evaluator.hs
+++ b/src/Juvix/Compiler/Core/Evaluator.hs
@@ -120,29 +120,32 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
         Nothing -> evalError "symbol not defined" n
 
 -- Evaluate `node` and interpret the builtin IO actions.
-evalIO :: IdentContext -> Env -> Node -> IO Node
-evalIO ctx env node =
+hEvalIO :: Handle -> Handle -> IdentContext -> Env -> Node -> IO Node
+hEvalIO hin hout ctx env node =
   let node' = eval ctx env node
    in case node' of
         Constr _ (BuiltinTag TagReturn) [x] ->
           return x
         Constr _ (BuiltinTag TagBind) [x, f] -> do
-          x' <- evalIO ctx env x
-          evalIO ctx env (App Info.empty f x')
+          x' <- hEvalIO hin hout ctx env x
+          hEvalIO hin hout ctx env (App Info.empty f x')
         Constr _ (BuiltinTag TagWrite) [Constant _ (ConstString s)] -> do
-          putStr s
+          hPutStr hout s
           return unitNode
         Constr _ (BuiltinTag TagWrite) [arg] -> do
-          putStr (ppPrint arg)
+          hPutStr hout (ppPrint arg)
           return unitNode
         Constr _ (BuiltinTag TagReadLn) [] -> do
-          hFlush stdout
-          Constant Info.empty . ConstString <$> getLine
+          hFlush hout
+          Constant Info.empty . ConstString <$> hGetLine hin
         _ ->
           return node'
   where
     unitNode = Constr (Info.singleton (NoDisplayInfo ())) (BuiltinTag TagNil) []
 
+evalIO :: IdentContext -> Env -> Node -> IO Node
+evalIO = hEvalIO stdin stdout
+
 -- Catch EvalError and convert it to CoreError. Needs a default location in case
 -- no location is available in EvalError.
 catchEvalError :: Location -> a -> IO (Either CoreError a)
diff --git a/src/Juvix/Compiler/Core/Translation/FromSource.hs b/src/Juvix/Compiler/Core/Translation/FromSource.hs
index 7520c1e61d..501fc35306 100644
--- a/src/Juvix/Compiler/Core/Translation/FromSource.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromSource.hs
@@ -1,4 +1,8 @@
-module Juvix.Compiler.Core.Translation.FromSource where
+module Juvix.Compiler.Core.Translation.FromSource
+  ( module Juvix.Compiler.Core.Translation.FromSource,
+    module Juvix.Parser.Error,
+  )
+where
 
 import Control.Monad.Trans.Class (lift)
 import Data.HashMap.Strict qualified as HashMap
diff --git a/test/Core.hs b/test/Core.hs
new file mode 100644
index 0000000000..5c9ee5f8f8
--- /dev/null
+++ b/test/Core.hs
@@ -0,0 +1,7 @@
+module Core where
+
+import Core.Positive qualified as P
+import Base
+
+allTests :: TestTree
+allTests = testGroup "JuvixCore tests" [P.allTests]
diff --git a/test/Core/Base.hs b/test/Core/Base.hs
new file mode 100644
index 0000000000..bd29499b0d
--- /dev/null
+++ b/test/Core/Base.hs
@@ -0,0 +1,63 @@
+module Core.Base where
+
+import Base
+import Data.Text.IO qualified as TIO
+import Juvix.Compiler.Core.Data.InfoTable
+import Juvix.Compiler.Core.Error
+import Juvix.Compiler.Core.Evaluator
+import Juvix.Compiler.Core.Extra
+import Juvix.Compiler.Core.Language
+import Juvix.Compiler.Core.Language.Info qualified as Info
+import Juvix.Compiler.Core.Language.Info.NoDisplayInfo
+import Juvix.Compiler.Core.Pretty
+import Juvix.Compiler.Core.Translation.FromSource
+import System.IO.Extra (withTempDir)
+import Text.Megaparsec.Pos qualified as M
+
+coreEvalAssertion :: FilePath -> FilePath -> (String -> IO ()) -> Assertion
+coreEvalAssertion mainFile expectedFile step = do
+  step "Parse"
+  r <- parseFile mainFile
+  case r of
+    Left err -> assertFailure (show (pretty err))
+    Right (_, Nothing) -> do
+      step "Compare expected and actual program output"
+      expected <- TIO.readFile expectedFile
+      assertEqDiff ("Check: EVAL output = " <> expectedFile) "" expected
+    Right (tab, Just node) -> do
+      withTempDir
+        ( \dirPath -> do
+            let outputFile = dirPath </> "out.out"
+            hout <- openFile outputFile WriteMode
+            step "Evaluate"
+            r' <- doEval mainFile hout tab node
+            case r' of
+              Left err -> do
+                hClose hout
+                assertFailure (show (pretty err))
+              Right value -> do
+                unless
+                  (Info.member kNoDisplayInfo (getInfo value))
+                  (hPutStrLn hout (ppPrint value))
+                hClose hout
+                actualOutput <- TIO.readFile outputFile
+                step "Compare expected and actual program output"
+                expected <- TIO.readFile expectedFile
+                assertEqDiff ("Check: EVAL output = " <> expectedFile) actualOutput expected
+        )
+
+parseFile :: FilePath -> IO (Either ParserError (InfoTable, Maybe Node))
+parseFile f = do
+  s <- readFile f
+  return $ runParser "" f emptyInfoTable s
+
+doEval ::
+  FilePath ->
+  Handle ->
+  InfoTable ->
+  Node ->
+  IO (Either CoreError Node)
+doEval f hout tab node =
+  catchEvalErrorIO defaultLoc (hEvalIO stdin hout (tab ^. identContext) [] node)
+  where
+    defaultLoc = singletonInterval (mkLoc f 0 (M.initialPos f))
diff --git a/test/Core/Positive.hs b/test/Core/Positive.hs
new file mode 100644
index 0000000000..1c5ccf9757
--- /dev/null
+++ b/test/Core/Positive.hs
@@ -0,0 +1,227 @@
+module Core.Positive where
+
+import Base
+import Core.Base
+
+data PosTest = PosTest
+  { _name :: String,
+    _relDir :: FilePath,
+    _file :: FilePath,
+    _expectedFile :: FilePath
+  }
+
+root :: FilePath
+root = "tests/Core/positive"
+
+testDescr :: PosTest -> TestDescr
+testDescr PosTest {..} =
+  let tRoot = root </> _relDir
+   in TestDescr
+        { _testName = _name,
+          _testRoot = tRoot,
+          _testAssertion = Steps $ coreEvalAssertion _file _expectedFile }
+
+allTests :: TestTree
+allTests =
+  testGroup
+    "JuvixCore positive tests"
+    (map (mkTest . testDescr) tests)
+
+tests :: [PosTest]
+tests =
+  [ PosTest
+      "Arithmetic operators"
+      "."
+      "test001.jvc"
+      "out/test001.out",
+    PosTest
+      "Arithmetic operators inside lambdas"
+      "."
+      "test002.jvc"
+      "out/test002.out",
+    PosTest
+      "Empty program with comments"
+      "."
+      "test003.jvc"
+      "out/test003.out",
+    PosTest
+      "IO builtins"
+      "."
+      "test004.jvc"
+      "out/test004.out",
+    PosTest
+      "Higher-order functions"
+      "."
+      "test005.jvc"
+      "out/test005.out",
+    PosTest
+      "If-then-else"
+      "."
+      "test006.jvc"
+      "out/test006.out",
+    PosTest
+      "Case"
+      "."
+      "test007.jvc"
+      "out/test007.out",
+    PosTest
+      "Recursion"
+      "."
+      "test008.jvc"
+      "out/test008.out",
+    PosTest
+      "Tail recursion"
+      "."
+      "test009.jvc"
+      "out/test009.out",
+    PosTest
+      "Let"
+      "."
+      "test010.jvc"
+      "out/test010.out",
+    PosTest
+      "Tail recursion: Fibonacci numbers in linear time"
+      "."
+      "test011.jvc"
+      "out/test011.out",
+    PosTest
+      "Trees"
+      "."
+      "test012.jvc"
+      "out/test012.out",
+    PosTest
+      "Functions returning functions with variable capture"
+      "."
+      "test013.jvc"
+      "out/test013.out",
+    PosTest
+      "Arithmetic"
+      "."
+      "test014.jvc"
+      "out/test014.out",
+    PosTest
+      "Local functions with free variables"
+      "."
+      "test015.jvc"
+      "out/test015.out",
+    PosTest
+      "Recursion through higher-order functions"
+      "."
+      "test016.jvc"
+      "out/test016.out",
+    PosTest
+      "Tail recursion through higher-order functions"
+      "."
+      "test017.jvc"
+      "out/test017.out",
+    PosTest
+      "Higher-order functions and recursion"
+      "."
+      "test018.jvc"
+      "out/test018.out",
+    PosTest
+      "Self-application"
+      "."
+      "test019.jvc"
+      "out/test019.out",
+    PosTest
+      "Recursive functions: McCarthy's 91 function, subtraction by increments"
+      "."
+      "test020.jvc"
+      "out/test020.out",
+    PosTest
+      "Higher-order recursive functions"
+      "."
+      "test021.jvc"
+      "out/test021.out",
+    PosTest
+      "Fast exponentiation"
+      "."
+      "test022.jvc"
+      "out/test022.out",
+    PosTest
+      "Lists"
+      "."
+      "test023.jvc"
+      "out/test023.out",
+    PosTest
+      "Structural equality"
+      "."
+      "test024.jvc"
+      "out/test024.out",
+    PosTest
+      "Mutual recursion"
+      "."
+      "test025.jvc"
+      "out/test025.out",
+    PosTest
+      "Nested 'case', 'let' and 'if' with variable capture"
+      "."
+      "test026.jvc"
+      "out/test026.out",
+    PosTest
+      "Euclid's algorithm"
+      "."
+      "test027.jvc"
+      "out/test027.out",
+    PosTest
+      "Functional queues"
+      "."
+      "test028.jvc"
+      "out/test028.out",
+    PosTest
+      "Church numerals"
+      "."
+      "test029.jvc"
+      "out/test029.out",
+    PosTest
+      "Streams without memoization"
+      "."
+      "test030.jvc"
+      "out/test030.out",
+    PosTest
+      "Ackermann function"
+      "."
+      "test031.jvc"
+      "out/test031.out",
+    PosTest
+      "Ackermann function (higher-order definition)"
+      "."
+      "test032.jvc"
+      "out/test032.out",
+    PosTest
+      "Nested lists"
+      "."
+      "test033.jvc"
+      "out/test033.out",
+{-    PosTest
+      "Evaluation order"
+      "."
+      "test034.jvc"
+      "out/test034.out", -}
+    PosTest
+      "Merge sort"
+      "."
+      "test035.jvc"
+      "out/test035.out",
+    PosTest
+      "Big numbers"
+      "."
+      "test036.jvc"
+      "out/test036.out",
+    PosTest
+      "Global variables"
+      "."
+      "test037.jvc"
+      "out/test037.out",
+    PosTest
+      "Global variables and forward declarations"
+      "."
+      "test038.jvc"
+      "out/test038.out",
+    PosTest
+      "Eta-expansion of builtins and constructors"
+      "."
+      "test039.jvc"
+      "out/test039.out"
+  ]
diff --git a/test/Main.hs b/test/Main.hs
index b72482e350..0e63bc512d 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -3,6 +3,7 @@ module Main (main) where
 import Arity qualified
 import BackendC qualified
 import Base
+import Core qualified
 import MonoJuvix qualified
 import Reachability qualified
 import Scope qualified
@@ -13,7 +14,9 @@ slowTests :: TestTree
 slowTests =
   testGroup
     "Juvix slow tests"
-    [BackendC.allTests]
+    [ BackendC.allTests,
+      Core.allTests
+    ]
 
 fastTests :: TestTree
 fastTests =
diff --git a/tests/Core/benchmark/out/test004.out b/tests/Core/benchmark/out/test004.out
new file mode 100644
index 0000000000..fd784f3c9d
--- /dev/null
+++ b/tests/Core/benchmark/out/test004.out
@@ -0,0 +1,4 @@
+541
+7919
+104729
+224737
diff --git a/tests/Core/benchmark/test004.jvc b/tests/Core/benchmark/test004.jvc
new file mode 100644
index 0000000000..ce462525be
--- /dev/null
+++ b/tests/Core/benchmark/test004.jvc
@@ -0,0 +1,34 @@
+-- streams without memoization
+
+def force := \f f nil;
+
+def filter := \p \s \_
+  case force s of {
+    cons h t ->
+      if p h then
+        cons h (filter p t)
+      else
+        force (filter p t)
+  };
+
+def nth := \n \s
+  case force s of {
+    cons h t -> if n = 1 then h else nth (n - 1) t
+  };
+
+def numbers := \n \_ cons n (numbers (n + 1));
+
+def indivisible := \n \x if x % n = 0 then false else true;
+def eratostenes := \s \_
+  case force s of {
+    cons n t ->
+      cons n (eratostenes (filter (indivisible n) t))
+  };
+def primes := eratostenes (numbers 2);
+
+def writeLn := \x write x >> write "\n";
+
+writeLn (nth 100 primes) >>
+writeLn (nth 1000 primes) >>
+writeLn (nth 10000 primes) >>
+writeLn (nth 20000 primes)
diff --git a/tests/Core/positive/out/test009.out b/tests/Core/positive/out/test009.out
index 1f6fb3c152..0aeb73169b 100644
--- a/tests/Core/positive/out/test009.out
+++ b/tests/Core/positive/out/test009.out
@@ -2,3 +2,4 @@
 5000050000
 120
 3628800
+93326215443944152681699238856266700490715968264381621468592963895217599993229915608941463976156518286253697920827223758251185210916864000000000000000000000000
diff --git a/tests/Core/positive/out/test028.out b/tests/Core/positive/out/test028.out
new file mode 100644
index 0000000000..fdbca9a789
--- /dev/null
+++ b/tests/Core/positive/out/test028.out
@@ -0,0 +1 @@
+cons 1 (cons 2 (cons 3 (cons 4 (cons 5 (cons 6 (cons 7 (cons 8 (cons 9 (cons 10 (cons 11 (cons 12 (cons 13 (cons 14 (cons 15 (cons 16 (cons 17 (cons 18 (cons 19 (cons 20 (cons 21 (cons 22 (cons 23 (cons 24 (cons 25 (cons 26 (cons 27 (cons 28 (cons 29 (cons 30 (cons 31 (cons 32 (cons 33 (cons 34 (cons 35 (cons 36 (cons 37 (cons 38 (cons 39 (cons 40 (cons 41 (cons 42 (cons 43 (cons 44 (cons 45 (cons 46 (cons 47 (cons 48 (cons 49 (cons 50 (cons 51 (cons 52 (cons 53 (cons 54 (cons 55 (cons 56 (cons 57 (cons 58 (cons 59 (cons 60 (cons 61 (cons 62 (cons 63 (cons 64 (cons 65 (cons 66 (cons 67 (cons 68 (cons 69 (cons 70 (cons 71 (cons 72 (cons 73 (cons 74 (cons 75 (cons 76 (cons 77 (cons 78 (cons 79 (cons 80 (cons 81 (cons 82 (cons 83 (cons 84 (cons 85 (cons 86 (cons 87 (cons 88 (cons 89 (cons 90 (cons 91 (cons 92 (cons 93 (cons 94 (cons 95 (cons 96 (cons 97 (cons 98 (cons 99 (cons 100 nil)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
diff --git a/tests/Core/positive/out/test029.out b/tests/Core/positive/out/test029.out
new file mode 100644
index 0000000000..a94dbefc6b
--- /dev/null
+++ b/tests/Core/positive/out/test029.out
@@ -0,0 +1,7 @@
+7
+21
+6
+5
+8
+13
+21
diff --git a/tests/Core/positive/out/test030.out b/tests/Core/positive/out/test030.out
new file mode 100644
index 0000000000..1c266518b8
--- /dev/null
+++ b/tests/Core/positive/out/test030.out
@@ -0,0 +1,3 @@
+cons 2 (cons 3 (cons 5 (cons 7 (cons 11 (cons 13 (cons 17 (cons 19 (cons 23 (cons 29 nil)))))))))
+547
+1229
diff --git a/tests/Core/positive/out/test031.out b/tests/Core/positive/out/test031.out
new file mode 100644
index 0000000000..215125f069
--- /dev/null
+++ b/tests/Core/positive/out/test031.out
@@ -0,0 +1,6 @@
+8
+9
+15
+17
+29
+1021
diff --git a/tests/Core/positive/out/test032.out b/tests/Core/positive/out/test032.out
new file mode 100644
index 0000000000..6e557e13de
--- /dev/null
+++ b/tests/Core/positive/out/test032.out
@@ -0,0 +1,4 @@
+10
+21
+2187
+1021
diff --git a/tests/Core/positive/out/test033.out b/tests/Core/positive/out/test033.out
new file mode 100644
index 0000000000..79e9454d7b
--- /dev/null
+++ b/tests/Core/positive/out/test033.out
@@ -0,0 +1,2 @@
+cons (cons 4 (cons 3 (cons 2 (cons 1 nil)))) (cons (cons 3 (cons 2 (cons 1 nil))) (cons (cons 2 (cons 1 nil)) (cons (cons 1 nil) nil)))
+cons 4 (cons 3 (cons 2 (cons 1 (cons 3 (cons 2 (cons 1 (cons 2 (cons 1 (cons 1 nil)))))))))
diff --git a/tests/Core/positive/out/test035.out b/tests/Core/positive/out/test035.out
new file mode 100644
index 0000000000..1fefa77c83
--- /dev/null
+++ b/tests/Core/positive/out/test035.out
@@ -0,0 +1,3 @@
+cons 2 (cons 3 (cons 4 (cons 5 (cons 6 (cons 7 (cons 8 (cons 9 (cons 10 (cons 11 nil)))))))))
+cons 2 (cons 3 (cons 4 (cons 5 (cons 6 (cons 7 (cons 8 (cons 9 (cons 10 (cons 11 nil)))))))))
+cons 2 (cons 3 (cons 4 (cons 5 (cons 6 (cons 7 (cons 8 (cons 9 (cons 10 (cons 11 nil)))))))))
diff --git a/tests/Core/positive/out/test036.out b/tests/Core/positive/out/test036.out
new file mode 100644
index 0000000000..37c8061232
--- /dev/null
+++ b/tests/Core/positive/out/test036.out
@@ -0,0 +1,51 @@
+1267650600228229401496703205376
+-126765060022822940149670320537674809325432
+-126765060021555289549442091136178106120056
+126765060024090590749898549939171512530808
+-160693804425899027554196209234211092338506843125049000988103690715922432
+-100000000001
+1267650600228229401421893879944
+
+1073741824
+2147483648
+4294967296
+4611686018427387904
+9223372036854775808
+18446744073709551616
+1267650600228229401496703205376
+1073741824
+-2147483648
+4294967296
+4611686018427387904
+-9223372036854775808
+18446744073709551616
+-2535301200456458802993406410752
+
+18446744073709551616
+8727963568087712425891397479476727340041449
+1267650600228229401496703205376
+126765060022822940149670320537674809325432
+
+100
+100
+50
+
+1073741824
+2147483648
+4294967296
+4611686018427387904
+9223372036854775808
+18446744073709551616
+1267650600228229401496703205376
+1073741824
+-2147483648
+4294967296
+4611686018427387904
+-9223372036854775808
+18446744073709551616
+-2535301200456458802993406410752
+
+10715086071862673209484250490600018105614048117055336074437503883703510511249361224931983788156958581275946729175531468251871452856923140435984577574698574803934567774824230985421074605062371141877954182153046474983581941267398767559165543946077062914571196477686542167660429831652624386837205668069376
+1322070819480806636890455259752144365965422032752148167664920368226828597346704899540778313850608061963909777696872582355950954582100618911865342725257953674027620225198320803878014774228964841274390400117588618041128947815623094438061566173054086674490506178125480344405547054397038895817465368254916136220830268563778582290228416398307887896918556404084898937609373242171846359938695516765018940588109060426089671438864102814350385648747165832010614366132173102768902855220001
+19950631168807583848837421626835850838234968318861924548520089498529438830221946631919961684036194597899331129423209124271556491349413781117593785932096323957855730046793794526765246551266059895520550086918193311542508608460618104685509074866089624888090489894838009253941633257850621568309473902556912388065225096643874441046759871626985453222868538161694315775629640762836880760732228535091641476183956381458969463899410840960536267821064621427333394036525565649530603142680234969400335934316651459297773279665775606172582031407994198179607378245683762280037302885487251900834464581454650557929601414833921615734588139257095379769119277800826957735674444123062018757836325502728323789270710373802866393031428133241401624195671690574061419654342324638801248856147305207431992259611796250130992860241708340807605932320161268492288496255841312844061536738951487114256315111089745514203313820202931640957596464756010405845841566072044962867016515061920631004186422275908670900574606417856951911456055068251250406007519842261898059237118054444788072906395242548339221982707404473162376760846613033778706039803413197133493654622700563169937455508241780972810983291314403571877524768509857276937926433221599399876886660808368837838027643282775172273657572744784112294389733810861607423253291974813120197604178281965697475898164531258434135959862784130128185406283476649088690521047580882615823961985770122407044330583075869039319604603404973156583208672105913300903752823415539745394397715257455290510212310947321610753474825740775273986348298498340756937955646638621874569499279016572103701364433135817214311791398222983845847334440270964182851005072927748364550578634501100852987812389473928699540834346158807043959118985815145779177143619698728131459483783202081474982171858011389071228250905826817436220577475921417653715687725614904582904992461028630081535583308130101987675856234343538955409175623400844887526162643568648833519463720377293240094456246923254350400678027273837755376406726898636241037491410966718557050759098100246789880178271925953381282421954028302759408448955014676668389697996886241636313376393903373455801407636741877711055384225739499110186468219696581651485130494222369947714763069155468217682876200362777257723781365331611196811280792669481887201298643660768551639860534602297871557517947385246369446923087894265948217008051120322365496288169035739121368338393591756418733850510970271613915439590991598154654417336311656936031122249937969999226781732358023111862644575299135758175008199839236284615249881088960232244362173771618086357015468484058622329792853875623486556440536962622018963571028812361567512543338303270029097668650568557157505516727518899194129711337690149916181315171544007728650573189557450920330185304847113818315407324053319038462084036421763703911550639789000742853672196280903477974533320468368795868580237952218629120080742819551317948157624448298518461509704888027274721574688131594750409732115080498190455803416826949787141316063210686391511681774304792596709376
+9990020930143845079440327643300335909804291390541816917715292738631458324642573483274873313324496504031643944455558549300187996607656176562908471354247492875198889629873671093246350427373112479265800278531241088737085605287228390164568691026850675923517914697052857644696801524832345475543250292786520806957770971741102232042976351205330777996897925116619870771785775955521720081320295204617949229259295623920965797873558158667525495797313144806249260261837941305080582686031535134178739622834990886357758062104606636372130587795322344972010808486369541401835851359858035603574021872908155566580607186461268972839794621842267579349638893357247588761959137656762411125020708704870465179396398710109200363934745618090601613377898560296863598558024761448933047052222860131377095958357319485898496404572383875170702242332633436894423297381877733153286944217936125301907868903603663283161502726139934152804071171914923903341874935394455896301292197256417717233543544751552379310892268182402452755752094704642185943862865632744231332084742221551493315002717750064228826211822549349600557457334964678483269180951895955769174509673224417740432840455882109137905375646772139976621785265057169854834562487518322383250318645505472114369934167981678170255122812978065194806295405339154657479941297499190348507544336414505631657396006693382427316434039580121280260984212247514207834712224831410304068603719640161855741656439472253464945249700314509890093162268952744428705476425472253167514521182231455388374308232642200633025137533129365164341725206256155311794738619142904761445654927128418175183531327052975495370561438239573227939673030106077456848477427832195349227983836436163764742969545906672369124136325932123335643135894465219101882123829740907916386023235450959388766736403229577993901152154448003637215069115591111996001530589107729421032230424262035693493216052927569625858445822354594645276923108197305806280326516736449343761732409753342333289730282959173569273013286423311759605230495171677033163709522256952460402143387655197644016528148022348331881097559421960476479388520198541017348985948511005469246617234143135309938405923268953586538886974427008607028635502085562029549352480050796521564919683265106744100967822951954161617717542997520009887307377876210685890770969411610438028623950445323789591870760289260393489826100774887672852918106468489143893649064784591211612193300707900537059042188012856559403699070888032966871611655961232331998310923225082866180321880439447572986762096935819784385927969250123326935194693207724335527365566248223787833888074999276831633440318604463618703789784313032843823470410944306591471928341190975185239212327674384990561563688432939039442002617530976850605132937101449086396141620556053547335569926700941375271829142407234267937565069765567475934101310225342830080409079587329544213551307302050171598424230760469209732907290141606353960880559202357376885647852240092777111489134492416995607171786298436533978180869474106751111353523711540436599310889697485658800887861974934357929246204051767246012250618404011966289872673803070498361217974484679100747846356194664829224736134115135567179291781968056053726484141128347858241259121954601184412409349782963317042002530418661694962318735860652485410222211869544223788289189712080514575141361964805369723164570564998479537657174548128597406077339158775332355215609435919275199351014222246963017013717419337504919295363295101115292951836282819191821651676455946515828048984256116748150367805267878662716999649296949377045794876146628110929982020737013330324451005385378551188803474148198665114579322684900993000236736168555294173442059925371965244997925483159343706343970371809611470323074186985035054722289027174850333368328300281132910841693150457389933183934593292994942796015309756118708918929528449074243284767006243171171622731766606796101967802204564589015899524704741001158110963633731329388356868949408759334176909387806398584647300588928175998844477486130063153068760070084837267527789777356830042778902772105683833021470279728595336332110564064263909724579949686162908019604141753935768876587992428549912151737924270343248648414247456838889541893241450987505759403013249697541696955330296880219304874163501097920036210238768275176369980977614979636096704348140124130683576879904997436596296495705459524735382000363770324894982103331332913562315169854410415317054193928234723398848453552173203688088312100943941434938282203549650281530751087098604681224802973825631244989331965296202372608586509050307993308652001231671915182765742095689513136184095412121473786311042897717861448158316965848766949554826252504961227044714712229620274682362909803877469376987358942125441792355298387479830450253909788733469732603097544156474805473732732767248652759034995336354126953900458854988683574927864615252040800490114785892289085443353996994780867471613519785838571456421583171193004117989440790268346357550339888086725127883577297626499213827436573992927302238792576924232785487201297255386071968303782483063725899808484638503828356258403917311872694381464553651690062530023217591343084755215901475299149215296944362366910833233693767993138209275870024246238331218236715236772098417187703860172308522448043176333602759733161201262248323085329288986154559221427378507410978822244729512663572225567169779409767341543017289268332635077451210167869121334465680739797372711461919299938118178827541421792926883790285430909942441260511945849237909966329550263865701114884142266162969810073652710928504579470861508094054577797864301504899958634164700528220562786008864025709432444254044034243140203812074857537999016066465520986980790589347320243050635907363821521280600041827529325485247927904235727598574209554632363830932428250711518801775633739811523761994686263270550635099851254333875594601540900862014293625673738331693082328854327001487476635118830885173775268819526360165345900556160767713453617655450974424979076063906093300028416964847594027046669468486593636425428625241644836652173922586528474244952363302305311413449332339822336551611431469131900170488226836525916399723912626616140205707996727383529597479125488961419287261259757561701592645823541151922177253919651034344793680369057003813056557866311011476313189571556336518727757991908862890765494952019474922148851417079252352394293801701149485239005844358329748769279941586384640877265901749104933238853465429979253900561311562288241147192158137210120267399648622831610430287268739840335142120299516610846193164688075944526965248570070554452152547493450434852917987512185973647190461515413582582139040172118295702327537027389787793506904044938553587650503557155872873201596885061331145477101575699375441097493374115991199114962726801718038950907803041184400075585468560976965669584325627283327416418044590727844680051360774154288412712456353383625469068936430902068216750459819321744513362913853983154560610459692604508787700304184579153478291725762810632722108035826060904572460619204237580363147200158749075361633785243462298769917887808671453928846572417223504887766803869453474588831907597355292800709241471370696647029530700507083091412492771404776193459007315206233634226128137074504162520473449597415678882003845446774388950379192344594171245510231738995030348421937088083329709108176561010708693158020695060096428352046647333361163476664106311247065173802510599409266908984046663298613648854871230659903565772327667696057187057276814394932559371368029375974604116075641599919402266794230681485723361363592903676841480358328093127506801111571615062761556607158236612268544268330274725849294875852089790850962835235527978491475563744318483993474633300330972497012808415900969455190375849945750379465019166009861502794606130794726898507849610303884846035423392175449505876157130344700415823080225786693300512126831846009510203543174323783292176865976076275412421892808138872880175813109296020150746331979561488146333412674896256883784351178477592660577212734269328382384711746083782209939646612308343952169576581065423771981899573840430315930973215059901371218399762585055435459516340055149080565627330475362528926945020226163130902420795006258931367813005222140742964756194053782182452833097021554210929638693005460011927178302761563505715735405672652524175925436371863471836292012162456662093642074605500842449347289830619506077570528754845277680661218358066130291463288932240701043887535007851997159198390084654596996197138399723495863749806582439384615049184048485819193560667125968018574877819561104335238420873417743385185735663101292757409280586840011804854994149478736882949368786637202682607198707656286436753775709560349718397405565505269425218354301348910785234517795519757516484711545928466003754558485470994737493796615841040414239875763335201795518644856632201598556341934286668912522153446348791218159622744525372314219184738770596659942181275403613660438538829201810204850917717791485256026242529802492309229562177062770027659288158473994804255067730903420043491632913588644627415318468517462580180901314477358637486528221274450661883667873545037139535563260349778209992416559111602097437491432360787879331015052417047437823553506205617017572175387061751192919715660363028302343819584946594328460482931960515124867123604625653903565173322856758210937541222674223847046664733620292824834065137814475367747671882220098389682019784216724015491253360436437847479770633657905418133523010804559958547379685864708937791659340223795537045273849435441105983887969741143051069401271065628507537039823308867819868298171415185218271493613110963984021912448323423901392553811725954153209435002954807640291982765741514042956666953177304003358701503703497424897898108939453026976878231557938158928996868766367603579055322794822757659104812835219745724022347569914650240636730492833286151875049129873457930874999488048681250802904606446223569562767964898914869924201946458521355165709887118378290437174375625282606140534611987395334677500936625746765638459629521872262777473480491233965194281353725068660782076683862565487279038020486778099991754380815789820825255566234983933217491493864966284116889874665005414748264599972752003370084542592544301190399041231752771993767799847551279448012913842034323154888137932524887172099381195722163148101670274877379161830968937348720168944903299658932511996504109653674618914861599481632040891930577238630396311858213341337110096389113836596895914715370925073998461682046426447290788976525593505136546978364603183820619560578517561504972661817649030304982138534738696212234626114043035600967042547012317360449724623287452575151198771801585742829389025650825988275495110865424704218337264023078045681651420517807418196096401513461760794362769612228126118610912766814880500950963889032877710837651051900076128058473969258768737937306664751387942217354694021157675557568970168734104342446525522568974329716152742558110503495045718931752447070410307760830365536714180388723602948872805590752711115590794756926903978519601939790311768070356801944936106850640568519290645048685535628256787225734544146565541187816717729850612874044620890718502108518025052924590359814117522720320552642597751984410742492179242039080014606225999422109717176118746845802673724801365603866909971071347255859723217027554055085082090418987534829222004178998475030519537179062001509333023023881806519182405550818672164711702307529922652228033820404113386625335815042934115143980939986416365633923620673874259342713444701242702722227197573203194489407856355511639619115985907995399083680129468810771595938084908111251938016414866250141095286680914828503123938960997659175977315432797173945762560365023587931559926170852315074247849814256564693008105061976397395591733545472917526739598790117477449217745771908169489543790314578152667389689410604588351445026130645637237687631129964576699475767340673583537218704935177320214779403972566532581731659202199752942824432778102107532160580104432121067208273876100778332426569624765621063126975491546224343978061253999313893915782008560011171319773443130412998215626985098895722778159524505640435534979855872234521991778419564106622122049039017886737997905270552302412002780864726282517525092332555378737792434915926182736151242592242725872699844014132567954640475742451126102857394193479716383187138370722782422619384021010896271281685732287764210298708895557148397743497418109849633633910397778254225179400022143485886207532122646613614487518735142494469575836744785028013193033901949738716163113800864093408529297729741462836142201120573027427309566658849884965134295188287937016147499504685185116851709758146686994243673140036992381232483920618628663037402351333907771907455224248515748726136075048020960976567862025232356273025557054386729189255571672396871991669651834736987440295942395220863481341484029838939485593327256627318194137735451891544384960966451285561476772564932516923822003229733483331726306200059192067441136913243720403578098676440894672367334549903905283682411422011886949265324531399323764100563996744273693606586851243936737155349696358970470706246743064681511525580772367129358691546677179280674603197443660235664811911175324239792271603213932690900431433572511935591785787438931910836722219749594385217682817205537433987939372420698422586002026702204502341484432231418159837133223467338185995720215212999066855318593765188122815644349842897804044474253173187198249880219056124756835053121936684091113613451740380400041281474527453687530122741226292549431008458868082627169312891414237466973215688306962596297824286828479758198382340345222708757345393897126910174835179971320922911746435455023926629385455742630840473245989374307836875864087914312319228307304975362481708579849870550314357368660453504099679685389802578477910419231052505144696885248726344365369453921372194715998156624454330562798282777349584666757018969900985110164491047993602922961645132995224271404908186948080818144765441476070834943179921347693205775493727581146799477819807044909830887802418354528095576268178221596410712216509995196961932368766959924336939018675830477951348564967496643006978548120861013029026482640402316621018258604172734501970838570222765188590393123627245232006535983907604127898007628220791246163222713051906678029644273228763460060289213316094057396003523608149487855784819923604033709243920895785100953666245538047118419834068589948934026518132741951749125192568729824877982938351710224389886834755562218214866075518628420508441240855088408499405226548535776678864444680504301285988469915501692621173049550268365498340637943341584797390666973271817567111123445212701138287733170703648843560692535012857745637166012927846194135756491508269323010063559087991831480179606664893606864875569154700860602703909640090514609360513037280984989976472934205971076104365706670369636731086616773064361333184164332104073479210775688703754193241101764488071673304176268034528127946729244452919161882095335945667158450941476301537032588109254921620602423998383939639570864268315557737923542830477169053850721939927266830567227442913752680237178175908437269780708099690192695002592421020485193953805155158663266418230452129371046840218806665165231438597498081621420148051355131865453014871298249938624272154345372391802215126115854861975398983110888196358875565793593310597895992053240439684590862193232015232257668969509415398393721308747247732944493053757577694362680328316055060353219685001207195191671426063364056179006218671604638684249067247572855764071631397824639188693789635247708232195940400450829593853651517642510129335911478337995658501766175785429966837417247838838645892319920041196390925354226074199412181950196251598137076467085022479201649174056794994024967593003129957099742026595785390010668925864718839026058417582396497109522944729874183273952292247592156943695682037477731049514128818431210317476600507328613045698141876738705835589680568812062901672389707603039549708273418484069037215179862266581929555420755695654139976814235027490594662592770986044588793675562143709648705744665319814772892177290937799834952769995145061157204394128687121538756842568036622321369508041915737469009917048039885947260486258684449762362318724085339500204989295963618739437408918888568903691128987832325892601331155260901131911962536529384643993465666490271108522834470184768391573623895239732781158399355178022076177450755929138381468526577309152290502509145241134006895661073761320484545645543610238773087594308408699782711315425513472058939339453013548135244176754131385012770024156261936169649709944156933541666590935759784775946468953923516229723673403650805886186209888123677098892944769654360324668874429740130365009770291603536426502844618046128137324006034947889707723262364927515545013731797277615272236008596598736693841467685030166103516988390995570659331713219574003251046303604196295276316972893990945091279545361627593486818455830168634280653205028729105026906643726170661778439311154737149759096116144493812106746037251452616271615212935043141124155849847574091878458410177325030553207237661933970254488335435069113577757765584551136714634629223114497809546405079026755854160954260557783406467356189398503160303046687522579708387993298769182986822970667356246647939653365454544268386404322650296028881298557242198187208040207296077496128886166773288838620609977925416822156713703667391333322086520871904473048593017466793578173830832406459585018177267447690376523178740142636502172093102619263046542112708094769682392207383797482057034793196525139221370199877543931178601238198924707047629587501516299912892933069025343575488251454948469328322898202956506903308470482517744131166464774750723477861518055343466858040987132273453081836794564364430155246274158100731069323080734901590517008753654169600998911569598454702926629374049393677685285723039754691181021469267219333846563053673846537824970049506209403506606244584412627902384242785280551599253188262786271531989567165398385428909311577122438618119724985644233907558812574859217687149721341833317289714977694982117227337669878361212788465289349470676995146785835955074121568375032937822352378665103266923449887690619794116574936418347914823983988002067649967289214983486424468737742286438563064425223461210639952418146166111391586408089740413945879849036682695488197808766021959964846771145698159367567904768112047055740602351237499012258567357965107013251562237843754994747236883821060645969480067316032381351192535148322216761442411144695361182838761115795911310362420741510826322048374540404146990479647073113428368300158247350712922331119789013179701651764033036649606749518628656836032556353205617386602749327417799524243899880581322620681297935615821202736455540414428705857131835238951742471239050758919353490570268302812810704750603181709274434806504843422134152201579626776393642698168851485545206897802036257496043584180735523092410264794436423951474855853980259367017205588767985309971043290404884467541701918912275745752402121744890326681160647837985004639864193645792082105266057503921195311457592621400830660301768120178560328650220171413811642155986702637531155554821958388905393544592180587272433749899242041542816666821846374863337522729077994208960545264863862516411718049112903451378140021506899966762080732651380427792460930762263446994159193223142565029996403134383564087766689537759857473403120477091886596355579944643688205981242040477802943803932459722207541739589596692034052161680837588921636048584789929663903107349945667027830610483130862872680661015300745521669893857383782690975026078691245077096697355744971063878379083608563324774011426604588797712843335089341752120843133549155805945217503766728136818989701075795034975931147113851177529084708382646930943663837851488798723688771534770333456570254004964039987760745951276145936694695508877796318400093229973736770518512573233230127134210937068680950264362225510872877141635601716276267040168996816287213326422268377855327887822310204539762272583014902609710931194995685950834598509258803363019551891846212990914920155838298607568190737375958573348261713794703592503972126314316192159571451081744034114847904386601284244643362857392442316767411036417557776991886719910511456902002905771699177497748359489810115650557253501242519595931483440417116222205504589671636754478042893488385500275211497526246421122010774862333476246182576597178403980436617669560567049936789350370893174617560282074679058110806280348893136768773133234721178541038289213080580369302853910384704528018344058313252744129928355732704028220901951560054449764635932065083760864473989692709381120504251266930834839999956860216356148940167442564078469350152730245749435722205009403680810321136898946443062041659878360406811331217133504960504944165472883926378607868385731515366373416312566122603235977742473940324793478740770352725436532455308438250865693864330020957120719122826689237609273524467576647981797622831709248187143189474449928329051087066866263901462754600186683583622062445553828867143621415773638244852570664653423002003386087185683387095282564231892337305827467825102905239214464117590700082862874915647212962223100149842773910585262712095702633425139069275541249925826898755913048489059083665047386569005980726512682643809800080768716889749767005747228285165430935469423701296901225200041775975278099341399149455675655415791289014141807180970818010668626000334746783492116354330741766556197865412944331579610856733907210970815247694360208231077377319255935591919361509992241851869762511821971598449396422923222586939583205849537600173388242916813257003198490942805178528782842560021549233235032941872842601109623432061485547579038802849228139397130979180562447703494299530585909415031237400213445431607049538809117870571045686211621069655023028886617060314580222884344906879404890744067164557565160596397488164744575409400891911083945126233990453364772541741331330821153758983077390402549739751620825837898384996200874749622331436354553599710472896396262914675542281735624665804212007275401273982269651802596130334329792865330063654175676003369688243926391280713123038760076039957285658333390838592534249337153070457471482743551037417147024006867419141874398230449202772009682282474640802779068104741602882613440803256607530230172031981070796893051954145239327661783905828943932146148894821695918579498502263858318704473290299790473193753803543920285706350672484245008920689712995308213747335255792982565803469779504974053329506220584586976782376547358092670753891736652401577525890202354883227480678961328466821865972869785592672826822656457577958670571097728396605101516387163615321918203652729897586807786443044896628670393188486921931839182927172554503767733076856308657600665342622254535057629030862718937364327448083558928220102374951534665262857504222950995446014428801859061443379679142717413278286975998259993819084477469775220567898395378570154609157695006128689610825519373486612568225010585752375050450503641627804406676905130564807191014132285063482665726828511933059433717373899623654715534816591630086838520905491060194596758223701911513581142071521220673521948777069521608531717477580542554138038978873716058241771904252401056370661792996395808706717083872950238057238547610495061732689587948240319569499000594593719849004104550034415014066154526994609094441391439071866309009249691812468813088126242358787204856089608234037677437509496768451058059579977189006605354903359961784245121096144877063187466910292356627771165203522647016166296488083808997887687769308220856530068153940856748041349469491870704992660210066455819832886130678021460369893174499939107231230405088342485383796742208847060385334943928147519685791292174441917386398739155908915859310750449419969425856920503891277550092560029225566028245733054164370482965351532695757311986033153861767127072322962670122480612322195488891848040149357757131302308897501348573600357134307046628157178720021578705983302856401851403674168523579202306440644159448586566246905477964086572462611834063213025126230896949713642334585419351128373132157232101577687884147986752364441711298472354763142715850293434746434127230225735792097083439910498394019789979870351837786010778667226102241684498686398874227580631272581474396676719404444290071284914286251867085092358453277091441099575357659812178523756848934429670368686181229928033433456696493460770903592231804072849827640955873854491455416480621098619090449331761288966135325413062313991971462332768487224184119088841054819270878948939590681778579588918587881426099241767753862382406002451821149035160124492893940578494055432173589779503867792448614769448734671863583817296627073341404027631029821562303142157743379294616649374361560459036060298581224576085252700570061877609582745974967405315882162695982851143006320897730473133461172142945805407178876223011462558510520930761771493278603541262719880522826864107055049364370555816945830840650960447321868266858216903784868032280479864021706315653687489290467679015864709379478762373013822026373788822827564163725872670921602434077279298565679825234946428376162918717556993454693724759744644374586123577768842647346924365909558553162571564807969034052671504760754742676960038255814034354716520834598864538432593908154392918939089896109083521992519053530398359081516289247571043354786424954980741388745386023113329591390636006694539437438690759589121288758007804082911975207095278133335550232776761783391381794105109412999680430103899475051243232331431120663598726618610084717254696908726637456858466646162093223427680684601718516702427671125913080059583053658180035991214447685286534985397013876080817020918472863351368783745251292936294373137797794168163130983688833624592488270042533275310174037401858155192663147588032450316349828944090941459435709839331454077937638533884824056964583661906580362312059760037127664830995125859310214290237306052000883415749724405028863402500028747055233688541068593389039662379913776485715772093749681055718277781429659244251666703110135820625316518906936462663613376783677001574909561444962828205690820330013121289873007855206280915035880334071746233511142838096550651818271177825964147342275885803162473648253508879276299074813242692461714169521068548818275361612786955216412383263246164034602771053052217127416909831714425842754359325193708367920524870186212708574531518197079797624156322369627530303625010057401503185241771381716916959066550480494267473696656051819527729740440782487416353087074803447126307550453018768734511631260002571765708294113447159058326859464022975489061868569715529325333679192904509181338989039531226114077604146341395120253199068720690450654317360799352434791082039695478061926453254644053124586362026016156957888326419910345519741792140396061817459467332211367113051675844970722080638249309285348257747082754939860608508486386549912912220391895379332321814344998458680557267915553525212113907723389037979427485209309504641599639196053296030292739274663906234190084882219800040754390250718430168480866157009022053158273857417267902310193566064243660834080202786392263652453395504706244108957791049298908397097715806857036527872932846771952274875201321856644284239116502005786314083266606564469023548865452436995428173054383481532525156311603438941440612599662264959878769003712412406305072713049361060777519351766684350979095112470377728527045181653556285621656761979382960837252084759203181114384404005114613990326273362146150667851880079327563486444803726963278475818453468509565365380723807736793526242145533088833679727074192838872685484977387306670007551965761431583941102042492623133242770270821710047137152167948872468741189259805623910487138975034203376673344989060052111727844670530521327425332189734978888307943626099125569741350839434061750712876445222039557455150019442996232739317091487905148812821582894579949748623433452865460274945133477267345362799684706610937707688048379567860499887327287273158785195505216946986571759372875984514994087366735699690322212619073372131984972873714823922056361158276719293687517950957314775347729780073870450969204201405641649670458849057466793682155521901095027966023590200629563426621697556166261956721403439803621918243177242110484823901622121433246394511832190737036276362556947535372619436126996645342229589006736952014870393865015087074414735220220770411070088328030731545041085721762448600324574529642445801550887535581445128918173686346116567111050151109714760544361537920207546115073529167935359803746233158035402507293585422134950239655004818456256327794930441926282941363007224150758144477688955569616025741423859274415740477217643474948663183182648210083785749080222199122144694117400270856159095104885845967392332602301843740328702808569782311182460392642129024729192535226787567897868564600570545108945374190649371558894253329703486982693386634574807801078719254129784907155276683405362407228975018016417486695226639468897799829747034414846605232977531914266638473906810541671168066131262918834764800639654762345192540580400257727950859061817326000188356677576249635084512266410557551645134470262083485480776173701923626406384831371842087477223094467978661221649689842322789248762605167898686475739012260361067924661728390016267344059903224026536343550301552983264519865881303942586617734987280231892544278016113318354276103258002393942607858756949485119300715853929843163967575531352484221274814864027297307155457109423432471856970523635672286551516265672389248080659279448953078708153606666741314598260798811278754656313007785743484189610809499119436037561075326359414143476882494692530787790693275290895909945065272071979419682741840819830567497688086236460819345623637702467815073133466197923119939117195979352833117496820500577299938566476984260815518940866776320855483159836188850448339911351505132909703990088919063133375804094886955895465912648104534621430295733375992898959329664444686900648674531661878821297194146191914132978673375283702995190706179924178140249356285006536273771636355569720003246996130665282451695167273161831393867558791278264933758040011059211372270839123518459709107480669852696080909181872978501574064544548264471078633386599113188810137746318984496745989011540334259315347740082110734818471521253374507271538131048296612979081477663269791394570357390537422769779633811568396223208402597025155304734389883109376
diff --git a/tests/Core/positive/out/test039.out b/tests/Core/positive/out/test039.out
new file mode 100644
index 0000000000..afc7b9f254
--- /dev/null
+++ b/tests/Core/positive/out/test039.out
@@ -0,0 +1,4 @@
+9
+cons 7 2
+5
+cons 3 2
diff --git a/tests/Core/positive/reference/test030.hs b/tests/Core/positive/reference/test030.hs
new file mode 100644
index 0000000000..56274823f7
--- /dev/null
+++ b/tests/Core/positive/reference/test030.hs
@@ -0,0 +1,8 @@
+
+import Data.List
+
+eratostenes :: [Integer] -> [Integer]
+eratostenes (h : t) = h : eratostenes (filter (\x -> x `mod` h /= 0) t)
+
+primes :: [Integer]
+primes = eratostenes [2..]
diff --git a/tests/Core/positive/test009.jvc b/tests/Core/positive/test009.jvc
index e6a824d0d1..78adb63f22 100644
--- a/tests/Core/positive/test009.jvc
+++ b/tests/Core/positive/test009.jvc
@@ -3,36 +3,13 @@
 def sum' := \x \acc if x = 0 then acc else sum' (x - 1) (x + acc);
 def sum := \x sum' x 0;
 
-{-
-
-def sum := \x0 loop (x := x0) (acc := 0) {
-  if x = 0 then acc else next (x - 1) (x + acc)
-};
-
-def sum := loop x (acc := 0) {
-  if x = 0 then acc else next (x - 1) (x + acc)
-};
-
-def sum :=
-  let rec next := \x \acc
-    if x = 0 then acc else next (x - 1) (x + acc)
-  in
-  \x next x 0
-
--}
-
 def fact' := \x \acc if x = 0 then acc else fact' (x - 1) (acc * x);
 def fact := \x fact' x 1;
 
-{-
-
-def fact := loop x (acc := 1) {
-  if x = 0 then acc else next (x - 1) (acc * x)
-};
-
--}
-
 def writeLn := \x write x >> write "\n";
 
 writeLn (sum 10000) >>
-writeLn (sum 100000)
+writeLn (sum 100000) >>
+writeLn (fact 5) >>
+writeLn (fact 10) >>
+writeLn (fact 100)
diff --git a/tests/Core/positive/test011.jvc b/tests/Core/positive/test011.jvc
index f383823b89..1353462a14 100644
--- a/tests/Core/positive/test011.jvc
+++ b/tests/Core/positive/test011.jvc
@@ -3,20 +3,6 @@
 def fib' := \n \x \y if n = 0 then x else fib' (n - 1) y (x + y);
 def fib := \n fib' n 0 1;
 
-{-
-
-def fib := loop n (x := 0) (y := 1) {
-  if n = 0 then x else next (n - 1) y (x + y)
-};
-
-def fib :=
-  let rec next := \n \x \y
-    if n = 0 then x else next (n - 1) y (x + y)
-  in
-  \n next n 0 1
-
--}
-
 def writeLn := \x write x >> write "\n";
 
 writeLn (fib 10) >>
diff --git a/tests/Core/positive/test015.jvc b/tests/Core/positive/test015.jvc
index 70fc80de50..9bc8d5d5a0 100644
--- a/tests/Core/positive/test015.jvc
+++ b/tests/Core/positive/test015.jvc
@@ -1,4 +1,4 @@
--- higher-order functions & local function definitions
+-- local functions with free variables
 
 def f := \x {
   let g := \y x + y in
diff --git a/tests/Core/positive/test021.jvc b/tests/Core/positive/test021.jvc
index 6dea5ad699..a39e35348b 100644
--- a/tests/Core/positive/test021.jvc
+++ b/tests/Core/positive/test021.jvc
@@ -1,4 +1,4 @@
--- higher-order recursive functions test
+-- higher-order recursive functions
 
 def not := \x if x then false else true;
 
diff --git a/tests/Core/positive/test028.jvc b/tests/Core/positive/test028.jvc
index 3e322c15c4..e5b1da93af 100644
--- a/tests/Core/positive/test028.jvc
+++ b/tests/Core/positive/test028.jvc
@@ -17,14 +17,17 @@ def snd := \q case q of { queue _ x -> x };
 
 def front := \q hd (fst q);
 
-def pop_front := \q \x
+def pop_front := \q
   let q' := queue (tl (fst q)) (snd q) in
   case fst q' of {
     nil -> queue (rev (snd q')) nil;
     _ -> q'
   };
 
-def push_back := \q \x queue (fst q) (cons x (snd q));
+def push_back := \q \x case fst q of {
+  nil -> queue (cons x nil) (snd q);
+  _ -> queue (fst q) (cons x (snd q))
+};
 
 def is_empty := \q case fst q of {
   nil -> case snd q of { nil -> true; _ -> false };
diff --git a/tests/Core/positive/test029.jvc b/tests/Core/positive/test029.jvc
index 658d5b0eb0..aa1919e8c9 100644
--- a/tests/Core/positive/test029.jvc
+++ b/tests/Core/positive/test029.jvc
@@ -1 +1,56 @@
 -- Church numerals
+
+constr pair 2;
+
+def fst := \p case p of { pair x _ -> x };
+def snd := \p case p of { pair _ x -> x };
+
+def compose := \f \g \x f (g x);
+
+def zero := \f \x x;
+
+def num := \n
+  if n = 0 then
+    zero
+  else
+    \f compose f (num (n - 1) f);
+
+def succ := \n \f compose f (n f);
+
+def add := \n \m \f compose (n f) (m f);
+
+def mul := \n \m \f n (m f);
+
+def isZero := \n n (\_ false) true;
+
+def pred := \n
+  fst (
+    n (\x
+        if isZero (snd x) then
+          pair (fst x) (succ (snd x))
+        else
+          pair (succ (fst x)) (succ (snd x)))
+      (pair zero zero)
+  );
+
+def toInt := \n n (+ 1) 0;
+
+def writeLn := \x write x >> write "\n";
+
+def fib := \n
+  if isZero n then
+    zero
+  else
+    let n' := pred n in
+    if isZero n' then
+      succ zero
+    else
+      add (fib n') (fib (pred n'));
+
+writeLn (toInt (num 7)) >>
+writeLn (toInt (mul (num 7) (num 3))) >>
+writeLn (toInt (pred (num 7))) >>
+writeLn (toInt (fib (num 5))) >>
+writeLn (toInt (fib (num 6))) >>
+writeLn (toInt (fib (num 7))) >>
+writeLn (toInt (fib (num 8)))
diff --git a/tests/Core/positive/test030.jvc b/tests/Core/positive/test030.jvc
index 6f3ae7d6b1..bfa1b44568 100644
--- a/tests/Core/positive/test030.jvc
+++ b/tests/Core/positive/test030.jvc
@@ -1 +1,41 @@
--- streams
+-- streams without memoization
+
+def force := \f f nil;
+
+def filter := \p \s \_
+  case force s of {
+    cons h t ->
+      if p h then
+        cons h (filter p t)
+      else
+        force (filter p t)
+  };
+
+def take := \n \s
+  if n = 0 then
+    nil
+  else
+    case force s of {
+      cons h t -> cons h (take (n - 1) t)
+    };
+
+def nth := \n \s
+  case force s of {
+    cons h t -> if n = 0 then h else nth (n - 1) t
+  };
+
+def numbers := \n \_ cons n (numbers (n + 1));
+
+def indivisible := \n \x if x % n = 0 then false else true;
+def eratostenes := \s \_
+  case force s of {
+    cons n t ->
+      cons n (eratostenes (filter (indivisible n) t))
+  };
+def primes := eratostenes (numbers 2);
+
+def writeLn := \x write x >> write "\n";
+
+writeLn (take 10 primes) >>
+writeLn (nth 100 primes) >>
+writeLn (nth 200 primes)
diff --git a/tests/Core/positive/test031.jvc b/tests/Core/positive/test031.jvc
index 2d2dc72879..75bc70519b 100644
--- a/tests/Core/positive/test031.jvc
+++ b/tests/Core/positive/test031.jvc
@@ -1 +1,18 @@
 -- Ackermann function
+
+def ack := \m \n
+  if m = 0 then
+    n + 1
+  else if n = 0 then
+    ack (m - 1) 1
+  else
+    ack (m - 1) (ack m (n - 1));
+
+def writeLn := \x write x >> write "\n";
+
+writeLn (ack 0 7) >>
+writeLn (ack 1 7) >>
+writeLn (ack 1 13) >>
+writeLn (ack 2 7) >>
+writeLn (ack 2 13) >>
+writeLn (ack 3 7)
diff --git a/tests/Core/positive/test032.jvc b/tests/Core/positive/test032.jvc
index b6b52e68b2..1bb72ee68f 100644
--- a/tests/Core/positive/test032.jvc
+++ b/tests/Core/positive/test032.jvc
@@ -1 +1,25 @@
 -- Ackermann function (higher-order definition)
+
+def compose := \f \g \x g (f x);
+
+def iterate := \f \n
+  if n = 0 then
+    \x x
+  else
+    compose f (iterate f (n - 1));
+
+def plus := iterate (+ 1);
+
+def mult := \m \n iterate (plus n) m 0;
+
+def exp := \m \n iterate (mult m) n 1;
+
+def ackermann := \m
+  iterate (\f \n iterate f (n + 1) 1) m (+ 1);
+
+def writeLn := \x write x >> write "\n";
+
+writeLn (plus 3 7) >>
+writeLn (mult 3 7) >>
+writeLn (exp 3 7) >>
+writeLn (ackermann 3 7)
diff --git a/tests/Core/positive/test033.jvc b/tests/Core/positive/test033.jvc
index f2599d28e4..39c6b55913 100644
--- a/tests/Core/positive/test033.jvc
+++ b/tests/Core/positive/test033.jvc
@@ -1 +1,19 @@
 -- nested lists
+
+def mklst := \n if n = 0 then nil else cons n (mklst (n - 1));
+def mklst2 := \n if n = 0 then nil else cons (mklst n) (mklst2 (n - 1));
+
+def append := \xs \ys case xs of {
+  nil -> ys;
+  cons x xs' -> cons x (append xs' ys);
+};
+
+def flatten := \xs case xs of {
+  nil -> nil;
+  cons x xs' -> append x (flatten xs');
+};
+
+def writeLn := \x write x >> write "\n";
+
+writeLn (mklst2 4) >>
+writeLn (flatten (mklst2 4))
diff --git a/tests/Core/positive/test035.jvc b/tests/Core/positive/test035.jvc
index db8a1e0685..5196b82666 100644
--- a/tests/Core/positive/test035.jvc
+++ b/tests/Core/positive/test035.jvc
@@ -1 +1,80 @@
 -- merge sort
+
+constr pair 2;
+
+def length := \xs case xs of {
+  nil -> 0;
+  cons _ xs' -> length xs' + 1
+};
+
+def split := \n \xs
+  if n = 0 then
+    pair nil xs
+  else
+    case xs of {
+      nil -> pair nil nil;
+      cons x xs' ->
+        case split (n - 1) xs' of {
+	  pair l1 l2 -> pair (cons x l1) l2
+	}
+    };
+
+def merge := \xs \ys case xs of {
+  nil -> ys;
+  cons x xs' -> case ys of {
+    nil -> xs;
+    cons y ys' ->
+      if x <= y then
+        cons x (merge xs' ys)
+      else
+        cons y (merge xs ys')
+  }
+};
+
+def sort := \xs
+  let n := length xs in
+  if n <= 1 then
+    xs
+  else
+    case split (length xs / 2) xs of {
+      pair l1 l2 -> merge (sort l1) (sort l2)
+    };
+
+def uniq := \xs case xs of {
+  nil -> nil;
+  cons x xs' -> case xs' of {
+    nil -> xs;
+    cons x' _ ->
+      if x = x' then
+        uniq xs'
+      else
+        cons x (uniq xs')
+  }
+};
+
+def append := \xs \ys case xs of {
+  nil -> ys;
+  cons x xs' -> cons x (append xs' ys);
+};
+
+def flatten := \xs case xs of {
+  nil -> nil;
+  cons x xs' -> append x (flatten xs');
+};
+
+def take := \n \xs
+  if n = 0 then
+    nil
+  else
+    case xs of {
+      cons x xs' -> cons x (take (n - 1) xs')
+    };
+
+def gen := \n \f \acc if n = 0 then acc else gen (n - 1) f (cons (f n) acc);
+def gen2 := \m \n \acc if n = 0 then acc else gen2 m (n - 1) (cons (gen m (+ n) nil) acc);
+
+def writeLn := \x write x >> write "\n";
+
+writeLn (take 10 (uniq (sort (flatten (gen2 6 40 nil))))) >>
+writeLn (take 10 (uniq (sort (flatten (gen2 9 80 nil))))) >>
+writeLn (take 10 (uniq (sort (flatten (gen2 6 80 nil)))))
diff --git a/tests/Core/positive/test036.jvc b/tests/Core/positive/test036.jvc
index ca3ee384ea..60d2d6e7e1 100644
--- a/tests/Core/positive/test036.jvc
+++ b/tests/Core/positive/test036.jvc
@@ -1 +1,100 @@
 -- big numbers
+
+def power' := \x \y \acc
+  if y = 0 then
+    acc
+  else
+    power' x (y - 1) (x * acc);
+def power := \x \y power' x y 1;
+
+def neg := \x 0 - x;
+
+def num1 := 1267650600228229401496703205376;
+def num2 := neg 126765060022822940149670320537674809325432;
+
+def sqrt' := \x \top \bot
+  if top - bot <= 1 then
+    bot
+  else
+    let y := (top + bot) / 2
+    in
+    if y * y > x then
+      sqrt' x y bot
+    else
+      sqrt' x top y;
+def sqrt := \x sqrt' x (x + 1) 0;
+
+def log' := \x \y \acc
+  if y = 1 then
+    acc
+  else
+    log' x (y / x) (acc + 1);
+def log := \x \y log' x y 0;
+
+def fast_power' := \x \y \acc
+  if y = 0 then
+    acc
+  else if y % 2 = 1 then
+    fast_power' (x * x) (y / 2) (x * acc)
+  else
+    fast_power' (x * x) (y / 2) acc;
+def fast_power := \x \y fast_power' x y 1;
+
+def writeLn := \x write x >> write "\n";
+
+writeLn num1 >>
+writeLn num2 >>
+writeLn (num1 + num2) >>
+writeLn (num1 - num2) >>
+writeLn (num1 * num2) >>
+writeLn (num2 / num1) >>
+writeLn (num2 % num1) >>
+writeLn "" >>
+
+writeLn (power 2 30) >>
+writeLn (power 2 31) >>
+writeLn (power 2 32) >>
+writeLn (power 2 62) >>
+writeLn (power 2 63) >>
+writeLn (power 2 64) >>
+writeLn (power 2 100) >>
+writeLn (power (neg 2) 30) >>
+writeLn (power (neg 2) 31) >>
+writeLn (power (neg 2) 32) >>
+writeLn (power (neg 2) 62) >>
+writeLn (power (neg 2) 63) >>
+writeLn (power (neg 2) 64) >>
+writeLn (power (neg 2) 101) >>
+writeLn "" >>
+
+writeLn (sqrt (power 2 128)) >>
+writeLn (sqrt (power 3 180)) >>
+writeLn (sqrt (power num1 2)) >>
+writeLn (sqrt (power num2 2)) >>
+writeLn "" >>
+
+writeLn (log 2 (power 2 100)) >>
+writeLn (log 20 (power 20 100)) >>
+writeLn (log 9 (power 3 100)) >>
+writeLn "" >>
+
+writeLn (fast_power 2 30) >>
+writeLn (fast_power 2 31) >>
+writeLn (fast_power 2 32) >>
+writeLn (fast_power 2 62) >>
+writeLn (fast_power 2 63) >>
+writeLn (fast_power 2 64) >>
+writeLn (fast_power 2 100) >>
+writeLn (fast_power (neg 2) 30) >>
+writeLn (fast_power (neg 2) 31) >>
+writeLn (fast_power (neg 2) 32) >>
+writeLn (fast_power (neg 2) 62) >>
+writeLn (fast_power (neg 2) 63) >>
+writeLn (fast_power (neg 2) 64) >>
+writeLn (fast_power (neg 2) 101) >>
+writeLn "" >>
+
+writeLn (fast_power 2 1000) >>
+writeLn (fast_power 3 1000) >>
+writeLn (fast_power 2 10000) >>
+writeLn (fast_power 2 100000)
diff --git a/tests/Core/positive/test039.jvc b/tests/Core/positive/test039.jvc
new file mode 100644
index 0000000000..46ae565e76
--- /dev/null
+++ b/tests/Core/positive/test039.jvc
@@ -0,0 +1,20 @@
+-- eta-expansion of builtins and constructors
+
+def f := \g g 2;
+def f' := \x f (+ x);
+
+def g := \f f 2;
+def g' := \x g (cons x);
+
+def f1 := \g g 2;
+def f1' := \x \y f (+ (x / y));
+
+def g1 := \f f 2;
+def g1' := \x \y g (cons (x / y));
+
+def writeLn := \x write x >> write "\n";
+
+writeLn (f' 7) >>
+writeLn (g' 7) >>
+writeLn (f1' 7 2) >>
+writeLn (g1' 7 2)

From be8884b9f168ce1103454cf18c8dfa92f9ff445c Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Mon, 22 Aug 2022 18:04:47 +0200
Subject: [PATCH 75/85] negative tests

---
 test/Core.hs                    |  3 +-
 test/Core/Base.hs               | 19 ++++++++++
 test/Core/Negative.hs           | 67 +++++++++++++++++++++++++++++++++
 tests/Core/negative/test001.jvc |  5 +++
 tests/Core/negative/test002.jvc |  5 +++
 tests/Core/negative/test003.jvc |  3 ++
 tests/Core/negative/test004.jvc |  3 ++
 tests/Core/negative/test005.jvc |  5 +++
 tests/Core/negative/test006.jvc |  3 ++
 tests/Core/negative/test007.jvc |  3 ++
 tests/Core/negative/test008.jvc |  5 +++
 tests/Core/negative/test009.jvc | 34 +++++++++++++++++
 12 files changed, 154 insertions(+), 1 deletion(-)
 create mode 100644 test/Core/Negative.hs
 create mode 100644 tests/Core/negative/test001.jvc
 create mode 100644 tests/Core/negative/test002.jvc
 create mode 100644 tests/Core/negative/test003.jvc
 create mode 100644 tests/Core/negative/test004.jvc
 create mode 100644 tests/Core/negative/test005.jvc
 create mode 100644 tests/Core/negative/test006.jvc
 create mode 100644 tests/Core/negative/test007.jvc
 create mode 100644 tests/Core/negative/test008.jvc
 create mode 100644 tests/Core/negative/test009.jvc

diff --git a/test/Core.hs b/test/Core.hs
index 5c9ee5f8f8..12f072ec2e 100644
--- a/test/Core.hs
+++ b/test/Core.hs
@@ -1,7 +1,8 @@
 module Core where
 
 import Core.Positive qualified as P
+import Core.Negative qualified as N
 import Base
 
 allTests :: TestTree
-allTests = testGroup "JuvixCore tests" [P.allTests]
+allTests = testGroup "JuvixCore tests" [P.allTests, N.allTests]
diff --git a/test/Core/Base.hs b/test/Core/Base.hs
index bd29499b0d..bed6c62dde 100644
--- a/test/Core/Base.hs
+++ b/test/Core/Base.hs
@@ -46,6 +46,25 @@ coreEvalAssertion mainFile expectedFile step = do
                 assertEqDiff ("Check: EVAL output = " <> expectedFile) actualOutput expected
         )
 
+coreEvalErrorAssertion :: FilePath -> (String -> IO ()) -> Assertion
+coreEvalErrorAssertion mainFile step = do
+  step "Parse"
+  r <- parseFile mainFile
+  case r of
+    Left _ -> assertBool "" True
+    Right (_, Nothing) -> assertFailure "no error"
+    Right (tab, Just node) -> do
+      withTempDir
+        ( \dirPath -> do
+            let outputFile = dirPath </> "out.out"
+            hout <- openFile outputFile WriteMode
+            step "Evaluate"
+            r' <- doEval mainFile hout tab node
+            case r' of
+              Left _ -> assertBool "" True
+              Right _ -> assertFailure "no error"
+        )
+
 parseFile :: FilePath -> IO (Either ParserError (InfoTable, Maybe Node))
 parseFile f = do
   s <- readFile f
diff --git a/test/Core/Negative.hs b/test/Core/Negative.hs
new file mode 100644
index 0000000000..093b3a780f
--- /dev/null
+++ b/test/Core/Negative.hs
@@ -0,0 +1,67 @@
+module Core.Negative where
+
+import Base
+import Core.Base
+
+data NegTest = NegTest
+  { _name :: String,
+    _relDir :: FilePath,
+    _file :: FilePath
+  }
+
+root :: FilePath
+root = "tests/Core/negative"
+
+testDescr :: NegTest -> TestDescr
+testDescr NegTest {..} =
+  let tRoot = root </> _relDir
+   in TestDescr
+        { _testName = _name,
+          _testRoot = tRoot,
+          _testAssertion = Steps $ coreEvalErrorAssertion _file }
+
+allTests :: TestTree
+allTests =
+  testGroup
+    "JuvixCore negative tests"
+    (map (mkTest . testDescr) tests)
+
+tests :: [NegTest]
+tests =
+  [ NegTest
+      "Division by zero"
+      "."
+      "test001.jvc",
+    NegTest
+      "Arithmetic operations on non-numbers"
+      "."
+      "test002.jvc",
+    NegTest
+      "Matching on non-data"
+      "."
+      "test003.jvc",
+    NegTest
+      "If on non-boolean"
+      "."
+      "test004.jvc",
+    NegTest
+      "No matching case branch"
+      "."
+      "test005.jvc",
+    NegTest
+      "Invalid application"
+      "."
+      "test006.jvc",
+    NegTest
+      "Invalid builtin application"
+      "."
+      "test007.jvc",
+    NegTest
+      "Undefined symbol"
+      "."
+      "test008.jvc",
+    NegTest
+      "Erroneous Chruch numerals"
+      "."
+      "test009.jvc"
+  ]
diff --git a/tests/Core/negative/test001.jvc b/tests/Core/negative/test001.jvc
new file mode 100644
index 0000000000..a0a78e1554
--- /dev/null
+++ b/tests/Core/negative/test001.jvc
@@ -0,0 +1,5 @@
+-- division by zero
+
+def f := \x 2 / x;
+
+f 0
diff --git a/tests/Core/negative/test002.jvc b/tests/Core/negative/test002.jvc
new file mode 100644
index 0000000000..eb59095a49
--- /dev/null
+++ b/tests/Core/negative/test002.jvc
@@ -0,0 +1,5 @@
+-- arithmetic operations on non-numbers
+
+def y := 3 + \x x;
+
+y
diff --git a/tests/Core/negative/test003.jvc b/tests/Core/negative/test003.jvc
new file mode 100644
index 0000000000..f25a2508e2
--- /dev/null
+++ b/tests/Core/negative/test003.jvc
@@ -0,0 +1,3 @@
+-- matching on non-data
+
+case \x x of nil -> nil
diff --git a/tests/Core/negative/test004.jvc b/tests/Core/negative/test004.jvc
new file mode 100644
index 0000000000..669679c84b
--- /dev/null
+++ b/tests/Core/negative/test004.jvc
@@ -0,0 +1,3 @@
+-- if on non-boolean
+
+if 2 then 1 else 0
diff --git a/tests/Core/negative/test005.jvc b/tests/Core/negative/test005.jvc
new file mode 100644
index 0000000000..9bc0e5ef54
--- /dev/null
+++ b/tests/Core/negative/test005.jvc
@@ -0,0 +1,5 @@
+-- no matching case branch
+
+case cons 1 2 of {
+  nil -> true
+}
diff --git a/tests/Core/negative/test006.jvc b/tests/Core/negative/test006.jvc
new file mode 100644
index 0000000000..48321673d5
--- /dev/null
+++ b/tests/Core/negative/test006.jvc
@@ -0,0 +1,3 @@
+-- invalid application
+
+(if true then 1 else 2) 3
diff --git a/tests/Core/negative/test007.jvc b/tests/Core/negative/test007.jvc
new file mode 100644
index 0000000000..6134d2a842
--- /dev/null
+++ b/tests/Core/negative/test007.jvc
@@ -0,0 +1,3 @@
+-- invalid builtin application
+
+(+ 2 3 4)
diff --git a/tests/Core/negative/test008.jvc b/tests/Core/negative/test008.jvc
new file mode 100644
index 0000000000..e667518f3a
--- /dev/null
+++ b/tests/Core/negative/test008.jvc
@@ -0,0 +1,5 @@
+-- undefined symbol
+
+def f;
+
+f
diff --git a/tests/Core/negative/test009.jvc b/tests/Core/negative/test009.jvc
new file mode 100644
index 0000000000..6aff7d429d
--- /dev/null
+++ b/tests/Core/negative/test009.jvc
@@ -0,0 +1,34 @@
+-- erroneous Church numerals
+
+constr pair 2;
+
+def fst := \p case p of { pair x _ -> x };
+def snd := \p case p of { pair _ x -> x };
+
+def compose := \f \g \x f (g x);
+
+def zero := \f \x x;
+
+def num := \n
+  if n = 0 then
+    zero
+  else
+    \f compose f (num (n - 1) f);
+
+def succ := \n \f compose f n; -- wrong
+
+def isZero := \n n (\_ false) true;
+
+def pred := \n
+  fst (
+    n (\x
+        if isZero (snd x) then
+          pair (fst x) (succ (snd x))
+        else
+          pair (succ (fst x)) (succ (snd x)))
+      (pair zero zero)
+  );
+
+def toInt := \n n (+ 1) 0;
+
+toInt (pred (num 7))

From 9c6098986c8c4a1427fca8abbab80db89095d07e Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Mon, 22 Aug 2022 18:21:50 +0200
Subject: [PATCH 76/85] test036 reference

---
 tests/Core/positive/reference/test036.hs | 108 +++++++++++++++++++++++
 1 file changed, 108 insertions(+)
 create mode 100644 tests/Core/positive/reference/test036.hs

diff --git a/tests/Core/positive/reference/test036.hs b/tests/Core/positive/reference/test036.hs
new file mode 100644
index 0000000000..09a0d4e7c8
--- /dev/null
+++ b/tests/Core/positive/reference/test036.hs
@@ -0,0 +1,108 @@
+
+power :: Integer -> Int -> Integer
+power x y = power' x y 1
+  where
+    power' x y acc =
+      if y == 0 then
+        acc
+      else
+        power' x (y - 1) (x * acc)
+
+num1 :: Integer
+num1 = 1267650600228229401496703205376
+
+num2 :: Integer
+num2 = -126765060022822940149670320537674809325432
+
+msqrt :: Integer -> Integer
+msqrt x = sqrt' x (x + 1) 0
+  where
+    sqrt' x top bot =
+      if top - bot <= 1 then
+        bot
+      else
+        let y = (top + bot) `div` 2
+        in
+          if y * y > x then
+            sqrt' x y bot
+          else
+            sqrt' x top y
+
+dlog :: Integer -> Integer -> Integer
+dlog x y = log' x y 0
+  where
+    log' x y acc =
+      if y == 1 then
+        acc
+      else
+        log' x (y `div` x) (acc + 1)
+
+fast_power :: Integer -> Int -> Integer
+fast_power x y = fast_power' x y 1
+  where
+    fast_power' x y acc =
+      if y == 0 then
+        acc
+      else if y `mod` 2 == 1 then
+        fast_power' (x * x) (y `div` 2) (x * acc)
+      else
+        fast_power' (x * x) (y `div` 2) acc
+
+main :: IO ()
+main = do
+  putStrLn $ show num1
+  putStrLn $ show num2
+  putStrLn $ show (num1 + num2)
+  putStrLn $ show (num1 - num2)
+  putStrLn $ show (num1 * num2)
+  putStrLn $ show (num2 `div` num1)
+  putStrLn $ show (num2 `mod` num1)
+  putStrLn ""
+
+  putStrLn $ show (power 2 30)
+  putStrLn $ show (power 2 31)
+  putStrLn $ show (power 2 32)
+  putStrLn $ show (power 2 62)
+  putStrLn $ show (power 2 63)
+  putStrLn $ show (power 2 64)
+  putStrLn $ show (power 2 100)
+  putStrLn $ show (power (-2) 30)
+  putStrLn $ show (power (-2) 31)
+  putStrLn $ show (power (-2) 32)
+  putStrLn $ show (power (-2) 62)
+  putStrLn $ show (power (-2) 63)
+  putStrLn $ show (power (-2) 64)
+  putStrLn $ show (power (-2) 101)
+  putStrLn ""
+
+  putStrLn $ show (msqrt (power 2 128))
+  putStrLn $ show (msqrt (power 3 180))
+  putStrLn $ show (msqrt (power num1 2))
+  putStrLn $ show (msqrt (power num2 2))
+  putStrLn ""
+
+  putStrLn $ show (dlog 2 (power 2 100))
+  putStrLn $ show (dlog 20 (power 20 100))
+  putStrLn $ show (dlog 9 (power 3 100))
+  putStrLn ""
+
+  putStrLn $ show (fast_power 2 30)
+  putStrLn $ show (fast_power 2 31)
+  putStrLn $ show (fast_power 2 32)
+  putStrLn $ show (fast_power 2 62)
+  putStrLn $ show (fast_power 2 63)
+  putStrLn $ show (fast_power 2 64)
+  putStrLn $ show (fast_power 2 100)
+  putStrLn $ show (fast_power (-2) 30)
+  putStrLn $ show (fast_power (-2) 31)
+  putStrLn $ show (fast_power (-2) 32)
+  putStrLn $ show (fast_power (-2) 62)
+  putStrLn $ show (fast_power (-2) 63)
+  putStrLn $ show (fast_power (-2) 64)
+  putStrLn $ show (fast_power (-2) 101)
+  putStrLn ""
+
+  putStrLn $ show (fast_power 2 1000)
+  putStrLn $ show (fast_power 3 1000)
+  putStrLn $ show (fast_power 2 10000)
+  putStrLn $ show (fast_power 2 100000)

From 7e10c7c795de4b4355fa9e86e7c3c844ea77ba3c Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Mon, 22 Aug 2022 19:18:57 +0200
Subject: [PATCH 77/85] debugging builtins

---
 src/Juvix/Compiler/Core/Evaluator.hs          | 22 ++++++++++++++-----
 src/Juvix/Compiler/Core/Language/Builtins.hs  |  4 ++++
 src/Juvix/Compiler/Core/Pretty/Base.hs        |  8 +++++++
 .../Compiler/Core/Translation/FromSource.hs   |  2 ++
 .../Core/Translation/FromSource/Lexer.hs      | 10 ++++++++-
 src/Juvix/Extra/Strings.hs                    |  6 +++++
 tests/Core/positive/out/test034.out           | 20 +++++++++++++++++
 tests/Core/positive/test034.jvc               | 15 +++++++++++++
 8 files changed, 80 insertions(+), 7 deletions(-)
 create mode 100644 tests/Core/positive/out/test034.out

diff --git a/src/Juvix/Compiler/Core/Evaluator.hs b/src/Juvix/Compiler/Core/Evaluator.hs
index fba484c967..9ec6d59ce8 100644
--- a/src/Juvix/Compiler/Core/Evaluator.hs
+++ b/src/Juvix/Compiler/Core/Evaluator.hs
@@ -8,6 +8,7 @@ module Juvix.Compiler.Core.Evaluator where
 
 import Control.Exception qualified as Exception
 import Data.HashMap.Strict qualified as HashMap
+import Debug.Trace qualified as Debug
 import GHC.Show as S
 import Juvix.Compiler.Core.Data.InfoTable
 import Juvix.Compiler.Core.Error
@@ -19,7 +20,7 @@ import Juvix.Compiler.Core.Pretty
 
 data EvalError = EvalError
   { _evalErrorMsg :: !Text,
-    _evalErrorNode :: !Node
+    _evalErrorNode :: !(Maybe Node)
   }
 
 makeLenses ''EvalError
@@ -29,8 +30,9 @@ instance Show EvalError where
   show (EvalError {..}) =
     "evaluation error: "
       ++ fromText _evalErrorMsg
-      ++ ": "
-      ++ fromText (ppTrace _evalErrorNode)
+      ++ case _evalErrorNode of
+        Nothing -> ""
+        Just node -> ": " ++ fromText (ppTrace node)
 
 -- We definitely do _not_ want to wrap the evaluator in an exception monad / the
 -- polysemy effects! This would almost double the execution time (whether an
@@ -48,7 +50,7 @@ eval :: IdentContext -> Env -> Node -> Node
 eval !ctx !env0 = convertRuntimeNodes . eval' env0
   where
     evalError :: Text -> Node -> a
-    evalError !msg !node = Exception.throw (EvalError msg node)
+    evalError !msg !node = Exception.throw (EvalError msg (Just node))
 
     eval' :: Env -> Node -> Node
     eval' !env !n = case n of
@@ -100,6 +102,9 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
     applyBuiltin _ env OpIntLt [l, r] = nodeFromBool (integerFromNode (eval' env l) < integerFromNode (eval' env r))
     applyBuiltin _ env OpIntLe [l, r] = nodeFromBool (integerFromNode (eval' env l) <= integerFromNode (eval' env r))
     applyBuiltin _ env OpEq [l, r] = nodeFromBool (eval' env l == eval' env r)
+    applyBuiltin _ env OpTrace [msg, x] = Debug.trace (printNode (eval' env msg)) (eval' env x)
+    applyBuiltin _ env OpFail [msg] =
+      Exception.throw (EvalError (fromString ("failure: " ++ printNode (eval' env msg))) Nothing)
     applyBuiltin n env _ _ = evalError "invalid builtin application" (substEnv env n)
 
     nodeFromInteger :: Integer -> Node
@@ -113,6 +118,11 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
       Constant _ (ConstInteger int) -> int
       v -> evalError "not an integer" v
 
+    printNode :: Node -> String
+    printNode = \case
+      Constant _ (ConstString s) -> fromText s
+      v -> fromText $ ppPrint v
+
     lookupContext :: Node -> Symbol -> Node
     lookupContext n sym =
       case HashMap.lookup sym ctx of
@@ -164,6 +174,6 @@ toCoreError :: Location -> EvalError -> CoreError
 toCoreError loc (EvalError {..}) =
   CoreError
     { _coreErrorMsg = mappend "evaluation error: " _evalErrorMsg,
-      _coreErrorNode = Just _evalErrorNode,
-      _coreErrorLoc = fromMaybe loc (lookupLocation _evalErrorNode)
+      _coreErrorNode = _evalErrorNode,
+      _coreErrorLoc = fromMaybe loc (lookupLocation =<< _evalErrorNode)
     }
diff --git a/src/Juvix/Compiler/Core/Language/Builtins.hs b/src/Juvix/Compiler/Core/Language/Builtins.hs
index 9189d5a634..f3ae4cd968 100644
--- a/src/Juvix/Compiler/Core/Language/Builtins.hs
+++ b/src/Juvix/Compiler/Core/Language/Builtins.hs
@@ -13,6 +13,8 @@ data BuiltinOp
   | OpIntLt
   | OpIntLe
   | OpEq
+  | OpTrace
+  | OpFail
   deriving stock (Eq)
 
 -- Builtin data tags
@@ -37,6 +39,8 @@ builtinOpArgsNum = \case
   OpIntLt -> 2
   OpIntLe -> 2
   OpEq -> 2
+  OpTrace -> 2
+  OpFail -> 1
 
 builtinConstrArgsNum :: BuiltinDataTag -> Int
 builtinConstrArgsNum = \case
diff --git a/src/Juvix/Compiler/Core/Pretty/Base.hs b/src/Juvix/Compiler/Core/Pretty/Base.hs
index 03a853368f..ab98966d2a 100644
--- a/src/Juvix/Compiler/Core/Pretty/Base.hs
+++ b/src/Juvix/Compiler/Core/Pretty/Base.hs
@@ -45,6 +45,8 @@ instance PrettyCode BuiltinOp where
     OpIntLt -> return kwLess
     OpIntLe -> return kwLessEquals
     OpEq -> return kwEquals
+    OpTrace -> return kwTrace
+    OpFail -> return kwFail
 
 instance PrettyCode BuiltinDataTag where
   ppCode = \case
@@ -264,3 +266,9 @@ kwElse = keyword Str.else_
 
 kwPi :: Doc Ann
 kwPi = keyword Str.pi_
+
+kwTrace :: Doc Ann
+kwTrace = keyword Str.trace_
+
+kwFail :: Doc Ann
+kwFail = keyword Str.fail_
diff --git a/src/Juvix/Compiler/Core/Translation/FromSource.hs b/src/Juvix/Compiler/Core/Translation/FromSource.hs
index 501fc35306..2c87141d69 100644
--- a/src/Juvix/Compiler/Core/Translation/FromSource.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromSource.hs
@@ -442,6 +442,8 @@ builtinAppExpr varsNum vars = do
       <|> (kwMinus >> return OpIntSub)
       <|> (kwDiv >> return OpIntDiv)
       <|> (kwMul >> return OpIntMul)
+      <|> (kwTrace >> return OpTrace)
+      <|> (kwFail >> return OpFail)
   args <- P.many (atom varsNum vars)
   return $ BuiltinApp Info.empty op args
 
diff --git a/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs b/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs
index 5a113348b2..d29ac7b791 100644
--- a/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs
@@ -84,7 +84,9 @@ allKeywords =
     kwGt,
     kwGe,
     kwBind,
-    kwSeq
+    kwSeq,
+    kwTrace,
+    kwFail
   ]
 
 lbrace :: ParsecS r ()
@@ -197,3 +199,9 @@ kwBind = keyword Str.bind
 
 kwSeq :: ParsecS r ()
 kwSeq = keyword Str.seq_
+
+kwTrace :: ParsecS r ()
+kwTrace = keyword Str.trace_
+
+kwFail :: ParsecS r ()
+kwFail = keyword Str.fail_
diff --git a/src/Juvix/Extra/Strings.hs b/src/Juvix/Extra/Strings.hs
index d29455ef3d..8e1fdcea75 100644
--- a/src/Juvix/Extra/Strings.hs
+++ b/src/Juvix/Extra/Strings.hs
@@ -149,6 +149,12 @@ bind = ">>="
 seq_ :: IsString s => s
 seq_ = ">>"
 
+trace_ :: IsString s => s
+trace_ = "trace"
+
+fail_ :: IsString s => s
+fail_ = "fail"
+
 data_ :: IsString s => s
 data_ = "data"
 
diff --git a/tests/Core/positive/out/test034.out b/tests/Core/positive/out/test034.out
new file mode 100644
index 0000000000..f5308ca637
--- /dev/null
+++ b/tests/Core/positive/out/test034.out
@@ -0,0 +1,20 @@
+1
+2
+3
+6
+1
+0
+1
+0
+1
+0
+1
+0
+1
+0
+9
+7
+2
+8
+3
+6
diff --git a/tests/Core/positive/test034.jvc b/tests/Core/positive/test034.jvc
index 42a36c830e..8a09945f55 100644
--- a/tests/Core/positive/test034.jvc
+++ b/tests/Core/positive/test034.jvc
@@ -1 +1,16 @@
 -- evaluation order
+
+def g := \x trace x g;
+
+def f := \x \y
+  if x = 0 then
+    9
+  else
+    trace 1 (f (x - 1) (y 0));
+
+def h := \x trace 8 (trace x (x + x));
+
+trace ((\x \y \z x + y + z) (trace "1" 1) (trace "2" 2) (trace "3" 3)) (
+trace (f 5 g) (trace 7 (
+h (trace 2 3)
+)))

From e78be96d634d3f0851b4d49cd4d09dcccc233bb5 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Mon, 22 Aug 2022 19:38:52 +0200
Subject: [PATCH 78/85] make ormolu happy

---
 src/Juvix/Compiler/Core/Pretty/Base.hs   |  7 ++--
 src/Juvix/Prelude/Base.hs                |  4 +--
 test/Core.hs                             |  4 +--
 test/Core/Negative.hs                    |  3 +-
 test/Core/Positive.hs                    | 13 +++----
 tests/Core/positive/reference/test026.hs | 28 +++++++--------
 tests/Core/positive/reference/test030.hs |  3 +-
 tests/Core/positive/reference/test036.hs | 43 +++++++++++-------------
 8 files changed, 50 insertions(+), 55 deletions(-)

diff --git a/src/Juvix/Compiler/Core/Pretty/Base.hs b/src/Juvix/Compiler/Core/Pretty/Base.hs
index ab98966d2a..28b7393c74 100644
--- a/src/Juvix/Compiler/Core/Pretty/Base.hs
+++ b/src/Juvix/Compiler/Core/Pretty/Base.hs
@@ -69,10 +69,9 @@ instance PrettyCode Node where
         Just ni -> do
           showDeBruijn <- asks (^. optShowDeBruijnIndices)
           n <- ppCode (ni ^. NameInfo.infoName)
-          if showDeBruijn then
-            return $ n <> kwDeBruijnVar <> pretty varIndex
-          else
-            return n
+          if showDeBruijn
+            then return $ n <> kwDeBruijnVar <> pretty varIndex
+            else return n
         Nothing -> return $ kwDeBruijnVar <> pretty varIndex
     Ident {..} ->
       case Info.lookup kNameInfo identInfo of
diff --git a/src/Juvix/Prelude/Base.hs b/src/Juvix/Prelude/Base.hs
index d9d9dc4e95..4a82465073 100644
--- a/src/Juvix/Prelude/Base.hs
+++ b/src/Juvix/Prelude/Base.hs
@@ -223,8 +223,8 @@ tableNestedInsert k1 k2 = tableInsert (HashMap.singleton k2) (HashMap.insert k2)
 --------------------------------------------------------------------------------
 
 revAppend :: [a] -> [a] -> [a]
-revAppend [] !ys = ys
-revAppend (x : xs) !ys = revAppend xs (x : ys)
+revAppend [] ys = ys
+revAppend (x : xs) ys = revAppend xs (x : ys)
 
 --------------------------------------------------------------------------------
 -- NonEmpty
diff --git a/test/Core.hs b/test/Core.hs
index 12f072ec2e..52a22ed4b5 100644
--- a/test/Core.hs
+++ b/test/Core.hs
@@ -1,8 +1,8 @@
 module Core where
 
-import Core.Positive qualified as P
-import Core.Negative qualified as N
 import Base
+import Core.Negative qualified as N
+import Core.Positive qualified as P
 
 allTests :: TestTree
 allTests = testGroup "JuvixCore tests" [P.allTests, N.allTests]
diff --git a/test/Core/Negative.hs b/test/Core/Negative.hs
index 093b3a780f..75949d9116 100644
--- a/test/Core/Negative.hs
+++ b/test/Core/Negative.hs
@@ -18,7 +18,8 @@ testDescr NegTest {..} =
    in TestDescr
         { _testName = _name,
           _testRoot = tRoot,
-          _testAssertion = Steps $ coreEvalErrorAssertion _file }
+          _testAssertion = Steps $ coreEvalErrorAssertion _file
+        }
 
 allTests :: TestTree
 allTests =
diff --git a/test/Core/Positive.hs b/test/Core/Positive.hs
index 1c5ccf9757..43a8f18ee3 100644
--- a/test/Core/Positive.hs
+++ b/test/Core/Positive.hs
@@ -19,7 +19,8 @@ testDescr PosTest {..} =
    in TestDescr
         { _testName = _name,
           _testRoot = tRoot,
-          _testAssertion = Steps $ coreEvalAssertion _file _expectedFile }
+          _testAssertion = Steps $ coreEvalAssertion _file _expectedFile
+        }
 
 allTests :: TestTree
 allTests =
@@ -194,11 +195,11 @@ tests =
       "."
       "test033.jvc"
       "out/test033.out",
-{-    PosTest
-      "Evaluation order"
-      "."
-      "test034.jvc"
-      "out/test034.out", -}
+    {-    PosTest
+          "Evaluation order"
+          "."
+          "test034.jvc"
+          "out/test034.out", -}
     PosTest
       "Merge sort"
       "."
diff --git a/tests/Core/positive/reference/test026.hs b/tests/Core/positive/reference/test026.hs
index b5074ef75a..c3fe024d6b 100644
--- a/tests/Core/positive/reference/test026.hs
+++ b/tests/Core/positive/reference/test026.hs
@@ -1,4 +1,3 @@
-
 data Tree = Leaf | Node Tree Tree
 
 gen :: Int -> Tree
@@ -7,20 +6,18 @@ gen n = if n <= 0 then Leaf else Node (gen (n - 2)) (gen (n - 1))
 f :: Tree -> Integer
 f Leaf = 1
 f (Node l r) =
-  let l' = g l in
-  let r' = g r in
-  let a = case l' of
-        Leaf -> -3
-        Node l r -> f l + f r
-  in
-  let b = case r' of
-        Node l r -> f l + f r
-        _ -> 2
-  in
-  a * b
+  let l' = g l
+   in let r' = g r
+       in let a = case l' of
+                Leaf -> -3
+                Node l r -> f l + f r
+           in let b = case r' of
+                    Node l r -> f l + f r
+                    _ -> 2
+               in a * b
 
 isNode :: Tree -> Bool
-isNode (Node _ _ ) = True
+isNode (Node _ _) = True
 isNode Leaf = False
 
 isLeaf :: Tree -> Bool
@@ -28,5 +25,8 @@ isLeaf Leaf = True
 isLeaf _ = False
 
 g :: Tree -> Tree
-g t = if isLeaf t then t else case t of
+g t =
+  if isLeaf t
+    then t
+    else case t of
       Node l r -> if isNode l then r else Node r l
diff --git a/tests/Core/positive/reference/test030.hs b/tests/Core/positive/reference/test030.hs
index 56274823f7..68b499d699 100644
--- a/tests/Core/positive/reference/test030.hs
+++ b/tests/Core/positive/reference/test030.hs
@@ -1,8 +1,7 @@
-
 import Data.List
 
 eratostenes :: [Integer] -> [Integer]
 eratostenes (h : t) = h : eratostenes (filter (\x -> x `mod` h /= 0) t)
 
 primes :: [Integer]
-primes = eratostenes [2..]
+primes = eratostenes [2 ..]
diff --git a/tests/Core/positive/reference/test036.hs b/tests/Core/positive/reference/test036.hs
index 09a0d4e7c8..289f1ed59a 100644
--- a/tests/Core/positive/reference/test036.hs
+++ b/tests/Core/positive/reference/test036.hs
@@ -1,12 +1,10 @@
-
 power :: Integer -> Int -> Integer
 power x y = power' x y 1
   where
     power' x y acc =
-      if y == 0 then
-        acc
-      else
-        power' x (y - 1) (x * acc)
+      if y == 0
+        then acc
+        else power' x (y - 1) (x * acc)
 
 num1 :: Integer
 num1 = 1267650600228229401496703205376
@@ -18,35 +16,32 @@ msqrt :: Integer -> Integer
 msqrt x = sqrt' x (x + 1) 0
   where
     sqrt' x top bot =
-      if top - bot <= 1 then
-        bot
-      else
-        let y = (top + bot) `div` 2
-        in
-          if y * y > x then
-            sqrt' x y bot
-          else
-            sqrt' x top y
+      if top - bot <= 1
+        then bot
+        else
+          let y = (top + bot) `div` 2
+           in if y * y > x
+                then sqrt' x y bot
+                else sqrt' x top y
 
 dlog :: Integer -> Integer -> Integer
 dlog x y = log' x y 0
   where
     log' x y acc =
-      if y == 1 then
-        acc
-      else
-        log' x (y `div` x) (acc + 1)
+      if y == 1
+        then acc
+        else log' x (y `div` x) (acc + 1)
 
 fast_power :: Integer -> Int -> Integer
 fast_power x y = fast_power' x y 1
   where
     fast_power' x y acc =
-      if y == 0 then
-        acc
-      else if y `mod` 2 == 1 then
-        fast_power' (x * x) (y `div` 2) (x * acc)
-      else
-        fast_power' (x * x) (y `div` 2) acc
+      if y == 0
+        then acc
+        else
+          if y `mod` 2 == 1
+            then fast_power' (x * x) (y `div` 2) (x * acc)
+            else fast_power' (x * x) (y `div` 2) acc
 
 main :: IO ()
 main = do

From 25bc4ba39b721420ffa02886ef8cb6ebc8a2b9e5 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Fri, 26 Aug 2022 13:56:04 +0200
Subject: [PATCH 79/85] refactor Info

---
 app/Main.hs                                        |  4 ++--
 src/Juvix/Compiler/Core/Evaluator.hs               |  4 ++--
 src/Juvix/Compiler/Core/Extra.hs                   |  2 +-
 src/Juvix/Compiler/Core/Extra/Base.hs              |  4 ++--
 src/Juvix/Compiler/Core/Extra/Info.hs              |  6 +++---
 src/Juvix/Compiler/Core/Extra/Recursors.hs         |  2 +-
 src/Juvix/Compiler/Core/{Language => }/Info.hs     |  6 +++---
 .../Core/{Language => }/Info/BinderInfo.hs         |  2 +-
 .../Core/{Language => }/Info/BranchInfo.hs         |  2 +-
 .../Core/{Language => }/Info/FreeVarsInfo.hs       |  4 ++--
 .../Compiler/Core/{Language => }/Info/IdentInfo.hs |  4 ++--
 .../Core/{Language => }/Info/LocationInfo.hs       |  2 +-
 .../Compiler/Core/{Language => }/Info/NameInfo.hs  |  2 +-
 .../Core/{Language => }/Info/NoDisplayInfo.hs      |  2 +-
 .../Compiler/Core/{Language => }/Info/TypeInfo.hs  |  2 +-
 src/Juvix/Compiler/Core/Language/Base.hs           |  2 +-
 .../Compiler/Core/Language/Info/ArgsNumInfo.hs     | 14 --------------
 src/Juvix/Compiler/Core/Pretty/Base.hs             |  8 ++++----
 src/Juvix/Compiler/Core/Translation/FromSource.hs  | 10 +++++-----
 test/Core/Base.hs                                  |  4 ++--
 test/Core/Negative.hs                              |  2 +-
 21 files changed, 37 insertions(+), 51 deletions(-)
 rename src/Juvix/Compiler/Core/{Language => }/Info.hs (91%)
 rename src/Juvix/Compiler/Core/{Language => }/Info/BinderInfo.hs (88%)
 rename src/Juvix/Compiler/Core/{Language => }/Info/BranchInfo.hs (87%)
 rename src/Juvix/Compiler/Core/{Language => }/Info/FreeVarsInfo.hs (91%)
 rename src/Juvix/Compiler/Core/{Language => }/Info/IdentInfo.hs (90%)
 rename src/Juvix/Compiler/Core/{Language => }/Info/LocationInfo.hs (78%)
 rename src/Juvix/Compiler/Core/{Language => }/Info/NameInfo.hs (76%)
 rename src/Juvix/Compiler/Core/{Language => }/Info/NoDisplayInfo.hs (74%)
 rename src/Juvix/Compiler/Core/{Language => }/Info/TypeInfo.hs (76%)
 delete mode 100644 src/Juvix/Compiler/Core/Language/Info/ArgsNumInfo.hs

diff --git a/app/Main.hs b/app/Main.hs
index e9fb6c254c..58a557c4b3 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -27,9 +27,9 @@ import Juvix.Compiler.Core.Data.InfoTable qualified as Core
 import Juvix.Compiler.Core.Error qualified as Core
 import Juvix.Compiler.Core.Evaluator qualified as Core
 import Juvix.Compiler.Core.Extra.Base qualified as Core
+import Juvix.Compiler.Core.Info qualified as Info
+import Juvix.Compiler.Core.Info.NoDisplayInfo qualified as Info
 import Juvix.Compiler.Core.Language qualified as Core
-import Juvix.Compiler.Core.Language.Info qualified as Info
-import Juvix.Compiler.Core.Language.Info.NoDisplayInfo qualified as Info
 import Juvix.Compiler.Core.Pretty qualified as Core
 import Juvix.Compiler.Core.Translation.FromSource qualified as Core
 import Juvix.Compiler.Internal.Pretty qualified as Internal
diff --git a/src/Juvix/Compiler/Core/Evaluator.hs b/src/Juvix/Compiler/Core/Evaluator.hs
index 9ec6d59ce8..f87e7027f7 100644
--- a/src/Juvix/Compiler/Core/Evaluator.hs
+++ b/src/Juvix/Compiler/Core/Evaluator.hs
@@ -13,9 +13,9 @@ import GHC.Show as S
 import Juvix.Compiler.Core.Data.InfoTable
 import Juvix.Compiler.Core.Error
 import Juvix.Compiler.Core.Extra
+import Juvix.Compiler.Core.Info qualified as Info
+import Juvix.Compiler.Core.Info.NoDisplayInfo
 import Juvix.Compiler.Core.Language
-import Juvix.Compiler.Core.Language.Info qualified as Info
-import Juvix.Compiler.Core.Language.Info.NoDisplayInfo
 import Juvix.Compiler.Core.Pretty
 
 data EvalError = EvalError
diff --git a/src/Juvix/Compiler/Core/Extra.hs b/src/Juvix/Compiler/Core/Extra.hs
index 1cdc815a8e..93f2e2ff6b 100644
--- a/src/Juvix/Compiler/Core/Extra.hs
+++ b/src/Juvix/Compiler/Core/Extra.hs
@@ -10,8 +10,8 @@ import Data.HashSet qualified as HashSet
 import Juvix.Compiler.Core.Extra.Base
 import Juvix.Compiler.Core.Extra.Info
 import Juvix.Compiler.Core.Extra.Recursors
+import Juvix.Compiler.Core.Info qualified as Info
 import Juvix.Compiler.Core.Language
-import Juvix.Compiler.Core.Language.Info qualified as Info
 
 -- `isClosed` may short-circuit evaluation due to the use of `&&`, so it's not
 -- entirely reducible to `getFreeVars` in terms of computation time.
diff --git a/src/Juvix/Compiler/Core/Extra/Base.hs b/src/Juvix/Compiler/Core/Extra/Base.hs
index b88cd1579c..199308a41b 100644
--- a/src/Juvix/Compiler/Core/Extra/Base.hs
+++ b/src/Juvix/Compiler/Core/Extra/Base.hs
@@ -2,9 +2,9 @@ module Juvix.Compiler.Core.Extra.Base where
 
 import Data.Functor.Identity
 import Data.List qualified as List
+import Juvix.Compiler.Core.Info qualified as Info
+import Juvix.Compiler.Core.Info.BinderInfo
 import Juvix.Compiler.Core.Language
-import Juvix.Compiler.Core.Language.Info qualified as Info
-import Juvix.Compiler.Core.Language.Info.BinderInfo
 
 {------------------------------------------------------------------------}
 {- functions on Type -}
diff --git a/src/Juvix/Compiler/Core/Extra/Info.hs b/src/Juvix/Compiler/Core/Extra/Info.hs
index 8df0a15925..07d69ffb11 100644
--- a/src/Juvix/Compiler/Core/Extra/Info.hs
+++ b/src/Juvix/Compiler/Core/Extra/Info.hs
@@ -2,10 +2,10 @@ module Juvix.Compiler.Core.Extra.Info where
 
 import Juvix.Compiler.Core.Extra.Base
 import Juvix.Compiler.Core.Extra.Recursors
+import Juvix.Compiler.Core.Info qualified as Info
+import Juvix.Compiler.Core.Info.LocationInfo
+import Juvix.Compiler.Core.Info.NameInfo
 import Juvix.Compiler.Core.Language
-import Juvix.Compiler.Core.Language.Info qualified as Info
-import Juvix.Compiler.Core.Language.Info.LocationInfo
-import Juvix.Compiler.Core.Language.Info.NameInfo
 
 mapInfo :: (Info -> Info) -> Node -> Node
 mapInfo f = umap (modifyInfo f)
diff --git a/src/Juvix/Compiler/Core/Extra/Recursors.hs b/src/Juvix/Compiler/Core/Extra/Recursors.hs
index 74e81bd4e5..0efd2659b2 100644
--- a/src/Juvix/Compiler/Core/Extra/Recursors.hs
+++ b/src/Juvix/Compiler/Core/Extra/Recursors.hs
@@ -8,8 +8,8 @@ import Data.Functor.Identity
 import Juvix.Compiler.Core.Data.BinderList (BinderList)
 import Juvix.Compiler.Core.Data.BinderList qualified as BL
 import Juvix.Compiler.Core.Extra.Base
+import Juvix.Compiler.Core.Info.BinderInfo
 import Juvix.Compiler.Core.Language
-import Juvix.Compiler.Core.Language.Info.BinderInfo
 
 {---------------------------------------------------------------------------------}
 {- General recursors on Node  -}
diff --git a/src/Juvix/Compiler/Core/Language/Info.hs b/src/Juvix/Compiler/Core/Info.hs
similarity index 91%
rename from src/Juvix/Compiler/Core/Language/Info.hs
rename to src/Juvix/Compiler/Core/Info.hs
index 5e48516ffb..fc43e462b3 100644
--- a/src/Juvix/Compiler/Core/Language/Info.hs
+++ b/src/Juvix/Compiler/Core/Info.hs
@@ -1,4 +1,4 @@
-module Juvix.Compiler.Core.Language.Info where
+module Juvix.Compiler.Core.Info where
 
 {-
   This file defines Infos stored in JuvixCore Nodes. The Info data structure
@@ -23,7 +23,7 @@ empty :: Info
 empty = Info HashMap.empty
 
 singleton :: forall a. IsInfo a => a -> Info
-singleton a = Juvix.Compiler.Core.Language.Info.insert a Juvix.Compiler.Core.Language.Info.empty
+singleton a = Juvix.Compiler.Core.Info.insert a Juvix.Compiler.Core.Info.empty
 
 member :: forall a. IsInfo a => Key a -> Info -> Bool
 member k i = HashMap.member (typeRep k) (i ^. infoMap)
@@ -38,7 +38,7 @@ lookupDefault a i =
   fromDyn (HashMap.lookupDefault (toDyn a) (typeOf a) (i ^. infoMap)) impossible
 
 (!) :: IsInfo a => Key a -> Info -> a
-(!) k i = fromJust (Juvix.Compiler.Core.Language.Info.lookup k i)
+(!) k i = fromJust (Juvix.Compiler.Core.Info.lookup k i)
 
 insert :: IsInfo a => a -> Info -> Info
 insert a i = Info (HashMap.insert (typeOf a) (toDyn a) (i ^. infoMap))
diff --git a/src/Juvix/Compiler/Core/Language/Info/BinderInfo.hs b/src/Juvix/Compiler/Core/Info/BinderInfo.hs
similarity index 88%
rename from src/Juvix/Compiler/Core/Language/Info/BinderInfo.hs
rename to src/Juvix/Compiler/Core/Info/BinderInfo.hs
index 084e47c3de..09911f2f85 100644
--- a/src/Juvix/Compiler/Core/Language/Info/BinderInfo.hs
+++ b/src/Juvix/Compiler/Core/Info/BinderInfo.hs
@@ -1,4 +1,4 @@
-module Juvix.Compiler.Core.Language.Info.BinderInfo where
+module Juvix.Compiler.Core.Info.BinderInfo where
 
 import Juvix.Compiler.Core.Language
 
diff --git a/src/Juvix/Compiler/Core/Language/Info/BranchInfo.hs b/src/Juvix/Compiler/Core/Info/BranchInfo.hs
similarity index 87%
rename from src/Juvix/Compiler/Core/Language/Info/BranchInfo.hs
rename to src/Juvix/Compiler/Core/Info/BranchInfo.hs
index d19a5442be..1dbfcf6936 100644
--- a/src/Juvix/Compiler/Core/Language/Info/BranchInfo.hs
+++ b/src/Juvix/Compiler/Core/Info/BranchInfo.hs
@@ -1,4 +1,4 @@
-module Juvix.Compiler.Core.Language.Info.BranchInfo where
+module Juvix.Compiler.Core.Info.BranchInfo where
 
 import Juvix.Compiler.Core.Language.Base
 
diff --git a/src/Juvix/Compiler/Core/Language/Info/FreeVarsInfo.hs b/src/Juvix/Compiler/Core/Info/FreeVarsInfo.hs
similarity index 91%
rename from src/Juvix/Compiler/Core/Language/Info/FreeVarsInfo.hs
rename to src/Juvix/Compiler/Core/Info/FreeVarsInfo.hs
index 653817e83e..6faaaded66 100644
--- a/src/Juvix/Compiler/Core/Language/Info/FreeVarsInfo.hs
+++ b/src/Juvix/Compiler/Core/Info/FreeVarsInfo.hs
@@ -1,9 +1,9 @@
-module Juvix.Compiler.Core.Language.Info.FreeVarsInfo where
+module Juvix.Compiler.Core.Info.FreeVarsInfo where
 
 import Data.HashMap.Strict qualified as HashMap
 import Juvix.Compiler.Core.Extra
+import Juvix.Compiler.Core.Info qualified as Info
 import Juvix.Compiler.Core.Language
-import Juvix.Compiler.Core.Language.Info qualified as Info
 
 newtype FreeVarsInfo = FreeVarsInfo
   { -- map free variables to the number of their occurrences
diff --git a/src/Juvix/Compiler/Core/Language/Info/IdentInfo.hs b/src/Juvix/Compiler/Core/Info/IdentInfo.hs
similarity index 90%
rename from src/Juvix/Compiler/Core/Language/Info/IdentInfo.hs
rename to src/Juvix/Compiler/Core/Info/IdentInfo.hs
index 6404b0bff2..6a26518f30 100644
--- a/src/Juvix/Compiler/Core/Language/Info/IdentInfo.hs
+++ b/src/Juvix/Compiler/Core/Info/IdentInfo.hs
@@ -1,9 +1,9 @@
-module Juvix.Compiler.Core.Language.Info.IdentInfo where
+module Juvix.Compiler.Core.Info.IdentInfo where
 
 import Data.HashMap.Strict qualified as HashMap
 import Juvix.Compiler.Core.Extra
+import Juvix.Compiler.Core.Info qualified as Info
 import Juvix.Compiler.Core.Language
-import Juvix.Compiler.Core.Language.Info qualified as Info
 
 newtype IdentInfo = IdentInfo
   { -- map symbols to the number of their occurrences
diff --git a/src/Juvix/Compiler/Core/Language/Info/LocationInfo.hs b/src/Juvix/Compiler/Core/Info/LocationInfo.hs
similarity index 78%
rename from src/Juvix/Compiler/Core/Language/Info/LocationInfo.hs
rename to src/Juvix/Compiler/Core/Info/LocationInfo.hs
index bd5a9da75b..5055152695 100644
--- a/src/Juvix/Compiler/Core/Language/Info/LocationInfo.hs
+++ b/src/Juvix/Compiler/Core/Info/LocationInfo.hs
@@ -1,4 +1,4 @@
-module Juvix.Compiler.Core.Language.Info.LocationInfo where
+module Juvix.Compiler.Core.Info.LocationInfo where
 
 import Juvix.Compiler.Core.Language.Base
 
diff --git a/src/Juvix/Compiler/Core/Language/Info/NameInfo.hs b/src/Juvix/Compiler/Core/Info/NameInfo.hs
similarity index 76%
rename from src/Juvix/Compiler/Core/Language/Info/NameInfo.hs
rename to src/Juvix/Compiler/Core/Info/NameInfo.hs
index 0e444a2551..dee6d91ac2 100644
--- a/src/Juvix/Compiler/Core/Language/Info/NameInfo.hs
+++ b/src/Juvix/Compiler/Core/Info/NameInfo.hs
@@ -1,4 +1,4 @@
-module Juvix.Compiler.Core.Language.Info.NameInfo where
+module Juvix.Compiler.Core.Info.NameInfo where
 
 import Juvix.Compiler.Core.Language.Base
 
diff --git a/src/Juvix/Compiler/Core/Language/Info/NoDisplayInfo.hs b/src/Juvix/Compiler/Core/Info/NoDisplayInfo.hs
similarity index 74%
rename from src/Juvix/Compiler/Core/Language/Info/NoDisplayInfo.hs
rename to src/Juvix/Compiler/Core/Info/NoDisplayInfo.hs
index 92a103ed17..0549362fc3 100644
--- a/src/Juvix/Compiler/Core/Language/Info/NoDisplayInfo.hs
+++ b/src/Juvix/Compiler/Core/Info/NoDisplayInfo.hs
@@ -1,4 +1,4 @@
-module Juvix.Compiler.Core.Language.Info.NoDisplayInfo where
+module Juvix.Compiler.Core.Info.NoDisplayInfo where
 
 import Juvix.Compiler.Core.Language.Base
 
diff --git a/src/Juvix/Compiler/Core/Language/Info/TypeInfo.hs b/src/Juvix/Compiler/Core/Info/TypeInfo.hs
similarity index 76%
rename from src/Juvix/Compiler/Core/Language/Info/TypeInfo.hs
rename to src/Juvix/Compiler/Core/Info/TypeInfo.hs
index 3032a3985f..3c935d5dab 100644
--- a/src/Juvix/Compiler/Core/Language/Info/TypeInfo.hs
+++ b/src/Juvix/Compiler/Core/Info/TypeInfo.hs
@@ -1,4 +1,4 @@
-module Juvix.Compiler.Core.Language.Info.TypeInfo where
+module Juvix.Compiler.Core.Info.TypeInfo where
 
 import Juvix.Compiler.Core.Language
 
diff --git a/src/Juvix/Compiler/Core/Language/Base.hs b/src/Juvix/Compiler/Core/Language/Base.hs
index 9b6da073db..82b1f9a01d 100644
--- a/src/Juvix/Compiler/Core/Language/Base.hs
+++ b/src/Juvix/Compiler/Core/Language/Base.hs
@@ -13,8 +13,8 @@ module Juvix.Compiler.Core.Language.Base
 where
 
 import Juvix.Compiler.Abstract.Data.Name
+import Juvix.Compiler.Core.Info (Info, IsInfo, Key)
 import Juvix.Compiler.Core.Language.Builtins
-import Juvix.Compiler.Core.Language.Info (Info, IsInfo, Key)
 import Juvix.Prelude
 
 type Location = Interval
diff --git a/src/Juvix/Compiler/Core/Language/Info/ArgsNumInfo.hs b/src/Juvix/Compiler/Core/Language/Info/ArgsNumInfo.hs
deleted file mode 100644
index 81914832b2..0000000000
--- a/src/Juvix/Compiler/Core/Language/Info/ArgsNumInfo.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-module Juvix.Compiler.Core.Language.Info.ArgsNumInfo where
-
-import Juvix.Compiler.Core.Language.Base
-
-newtype ArgsNumInfo = ArgsNumInfo
-  { _infoArgsNum :: Int
-  }
-
-instance IsInfo ArgsNumInfo
-
-kArgsNumInfo :: Key ArgsNumInfo
-kArgsNumInfo = Proxy
-
-makeLenses ''ArgsNumInfo
diff --git a/src/Juvix/Compiler/Core/Pretty/Base.hs b/src/Juvix/Compiler/Core/Pretty/Base.hs
index 28b7393c74..8d90f9532c 100644
--- a/src/Juvix/Compiler/Core/Pretty/Base.hs
+++ b/src/Juvix/Compiler/Core/Pretty/Base.hs
@@ -6,11 +6,11 @@ module Juvix.Compiler.Core.Pretty.Base
 where
 
 import Juvix.Compiler.Core.Extra
+import Juvix.Compiler.Core.Info qualified as Info
+import Juvix.Compiler.Core.Info.BinderInfo as BinderInfo
+import Juvix.Compiler.Core.Info.BranchInfo as BranchInfo
+import Juvix.Compiler.Core.Info.NameInfo as NameInfo
 import Juvix.Compiler.Core.Language
-import Juvix.Compiler.Core.Language.Info qualified as Info
-import Juvix.Compiler.Core.Language.Info.BinderInfo as BinderInfo
-import Juvix.Compiler.Core.Language.Info.BranchInfo as BranchInfo
-import Juvix.Compiler.Core.Language.Info.NameInfo as NameInfo
 import Juvix.Compiler.Core.Pretty.Options
 import Juvix.Data.CodeAnn
 import Juvix.Extra.Strings qualified as Str
diff --git a/src/Juvix/Compiler/Core/Translation/FromSource.hs b/src/Juvix/Compiler/Core/Translation/FromSource.hs
index 2c87141d69..49cbfccf23 100644
--- a/src/Juvix/Compiler/Core/Translation/FromSource.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromSource.hs
@@ -10,12 +10,12 @@ import Data.List qualified as List
 import Juvix.Compiler.Core.Data.InfoTable
 import Juvix.Compiler.Core.Data.InfoTableBuilder
 import Juvix.Compiler.Core.Extra.Base
+import Juvix.Compiler.Core.Info qualified as Info
+import Juvix.Compiler.Core.Info.BinderInfo as BinderInfo
+import Juvix.Compiler.Core.Info.BranchInfo as BranchInfo
+import Juvix.Compiler.Core.Info.LocationInfo as LocationInfo
+import Juvix.Compiler.Core.Info.NameInfo as NameInfo
 import Juvix.Compiler.Core.Language
-import Juvix.Compiler.Core.Language.Info qualified as Info
-import Juvix.Compiler.Core.Language.Info.BinderInfo as BinderInfo
-import Juvix.Compiler.Core.Language.Info.BranchInfo as BranchInfo
-import Juvix.Compiler.Core.Language.Info.LocationInfo as LocationInfo
-import Juvix.Compiler.Core.Language.Info.NameInfo as NameInfo
 import Juvix.Compiler.Core.Transformation.Eta
 import Juvix.Compiler.Core.Translation.FromSource.Lexer
 import Juvix.Parser.Error
diff --git a/test/Core/Base.hs b/test/Core/Base.hs
index bed6c62dde..afd23810c3 100644
--- a/test/Core/Base.hs
+++ b/test/Core/Base.hs
@@ -6,9 +6,9 @@ import Juvix.Compiler.Core.Data.InfoTable
 import Juvix.Compiler.Core.Error
 import Juvix.Compiler.Core.Evaluator
 import Juvix.Compiler.Core.Extra
+import Juvix.Compiler.Core.Info qualified as Info
+import Juvix.Compiler.Core.Info.NoDisplayInfo
 import Juvix.Compiler.Core.Language
-import Juvix.Compiler.Core.Language.Info qualified as Info
-import Juvix.Compiler.Core.Language.Info.NoDisplayInfo
 import Juvix.Compiler.Core.Pretty
 import Juvix.Compiler.Core.Translation.FromSource
 import System.IO.Extra (withTempDir)
diff --git a/test/Core/Negative.hs b/test/Core/Negative.hs
index 75949d9116..ddffc58b04 100644
--- a/test/Core/Negative.hs
+++ b/test/Core/Negative.hs
@@ -62,7 +62,7 @@ tests =
       "."
       "test008.jvc",
     NegTest
-      "Erroneous Chruch numerals"
+      "Erroneous Church numerals"
       "."
       "test009.jvc"
   ]

From fa066656d9bed7327e43c17907636c725b5e9bb3 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Mon, 29 Aug 2022 07:57:32 +0200
Subject: [PATCH 80/85] Info.lookup'

---
 src/Juvix/Compiler/Core/Info.hs | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/src/Juvix/Compiler/Core/Info.hs b/src/Juvix/Compiler/Core/Info.hs
index fc43e462b3..acfb9feddd 100644
--- a/src/Juvix/Compiler/Core/Info.hs
+++ b/src/Juvix/Compiler/Core/Info.hs
@@ -37,8 +37,11 @@ lookupDefault :: IsInfo a => a -> Info -> a
 lookupDefault a i =
   fromDyn (HashMap.lookupDefault (toDyn a) (typeOf a) (i ^. infoMap)) impossible
 
+lookup' :: IsInfo a => Key a -> Info -> a
+lookup' k i = fromMaybe impossible (Juvix.Compiler.Core.Info.lookup k i)
+
 (!) :: IsInfo a => Key a -> Info -> a
-(!) k i = fromJust (Juvix.Compiler.Core.Info.lookup k i)
+(!) = lookup'
 
 insert :: IsInfo a => a -> Info -> Info
 insert a i = Info (HashMap.insert (typeOf a) (toDyn a) (i ^. infoMap))

From 2133c226e7043015ae9bbac1f052d968254079a0 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Mon, 29 Aug 2022 08:34:22 +0200
Subject: [PATCH 81/85] remove 'nil' and 'cons' builtin constructors

---
 src/Juvix/Compiler/Core/Evaluator.hs              | 2 +-
 src/Juvix/Compiler/Core/Language/Builtins.hs      | 6 ++----
 src/Juvix/Compiler/Core/Pretty/Base.hs            | 3 +--
 src/Juvix/Compiler/Core/Translation/FromSource.hs | 2 --
 tests/Core/benchmark/test004.jvc                  | 3 +++
 tests/Core/negative/test005.jvc                   | 2 ++
 tests/Core/positive/test007.jvc                   | 3 +++
 tests/Core/positive/test023.jvc                   | 3 +++
 tests/Core/positive/test024.jvc                   | 3 +++
 tests/Core/positive/test028.jvc                   | 3 +++
 tests/Core/positive/test030.jvc                   | 3 +++
 tests/Core/positive/test033.jvc                   | 3 +++
 tests/Core/positive/test035.jvc                   | 7 +++++--
 tests/Core/positive/test037.jvc                   | 2 ++
 tests/Core/positive/test039.jvc                   | 2 ++
 15 files changed, 36 insertions(+), 11 deletions(-)

diff --git a/src/Juvix/Compiler/Core/Evaluator.hs b/src/Juvix/Compiler/Core/Evaluator.hs
index f87e7027f7..988a91fc4f 100644
--- a/src/Juvix/Compiler/Core/Evaluator.hs
+++ b/src/Juvix/Compiler/Core/Evaluator.hs
@@ -151,7 +151,7 @@ hEvalIO hin hout ctx env node =
         _ ->
           return node'
   where
-    unitNode = Constr (Info.singleton (NoDisplayInfo ())) (BuiltinTag TagNil) []
+    unitNode = Constr (Info.singleton (NoDisplayInfo ())) (BuiltinTag TagVoid) []
 
 evalIO :: IdentContext -> Env -> Node -> IO Node
 evalIO = hEvalIO stdin stdout
diff --git a/src/Juvix/Compiler/Core/Language/Builtins.hs b/src/Juvix/Compiler/Core/Language/Builtins.hs
index f3ae4cd968..1d7785810f 100644
--- a/src/Juvix/Compiler/Core/Language/Builtins.hs
+++ b/src/Juvix/Compiler/Core/Language/Builtins.hs
@@ -19,8 +19,7 @@ data BuiltinOp
 
 -- Builtin data tags
 data BuiltinDataTag
-  = TagNil
-  | TagCons
+  = TagVoid
   | TagReturn
   | TagBind
   | TagWrite
@@ -44,8 +43,7 @@ builtinOpArgsNum = \case
 
 builtinConstrArgsNum :: BuiltinDataTag -> Int
 builtinConstrArgsNum = \case
-  TagNil -> 0
-  TagCons -> 2
+  TagVoid -> 0
   TagReturn -> 1
   TagBind -> 2
   TagWrite -> 1
diff --git a/src/Juvix/Compiler/Core/Pretty/Base.hs b/src/Juvix/Compiler/Core/Pretty/Base.hs
index 8d90f9532c..b12551f9b3 100644
--- a/src/Juvix/Compiler/Core/Pretty/Base.hs
+++ b/src/Juvix/Compiler/Core/Pretty/Base.hs
@@ -50,8 +50,7 @@ instance PrettyCode BuiltinOp where
 
 instance PrettyCode BuiltinDataTag where
   ppCode = \case
-    TagNil -> return $ annotate (AnnKind KNameConstructor) (pretty ("nil" :: String))
-    TagCons -> return $ annotate (AnnKind KNameConstructor) (pretty ("cons" :: String))
+    TagVoid -> return $ annotate (AnnKind KNameConstructor) (pretty ("void" :: String))
     TagReturn -> return $ annotate (AnnKind KNameConstructor) (pretty ("return" :: String))
     TagBind -> return $ annotate (AnnKind KNameConstructor) (pretty ("bind" :: String))
     TagWrite -> return $ annotate (AnnKind KNameConstructor) (pretty ("write" :: String))
diff --git a/src/Juvix/Compiler/Core/Translation/FromSource.hs b/src/Juvix/Compiler/Core/Translation/FromSource.hs
index 49cbfccf23..6a288c9f0d 100644
--- a/src/Juvix/Compiler/Core/Translation/FromSource.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromSource.hs
@@ -92,8 +92,6 @@ declareBuiltins :: Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r
 declareBuiltins = do
   loc <- curLoc
   let i = mkInterval loc loc
-  lift $ declareBuiltinConstr TagNil "nil" i
-  lift $ declareBuiltinConstr TagCons "cons" i
   lift $ declareBuiltinConstr TagReturn "return" i
   lift $ declareBuiltinConstr TagBind "bind" i
   lift $ declareBuiltinConstr TagWrite "write" i
diff --git a/tests/Core/benchmark/test004.jvc b/tests/Core/benchmark/test004.jvc
index ce462525be..0e0b65aded 100644
--- a/tests/Core/benchmark/test004.jvc
+++ b/tests/Core/benchmark/test004.jvc
@@ -1,5 +1,8 @@
 -- streams without memoization
 
+constr nil 0;
+constr cons 2;
+
 def force := \f f nil;
 
 def filter := \p \s \_
diff --git a/tests/Core/negative/test005.jvc b/tests/Core/negative/test005.jvc
index 9bc0e5ef54..0e95d61269 100644
--- a/tests/Core/negative/test005.jvc
+++ b/tests/Core/negative/test005.jvc
@@ -1,5 +1,7 @@
 -- no matching case branch
 
+constr cons 2;
+
 case cons 1 2 of {
   nil -> true
 }
diff --git a/tests/Core/positive/test007.jvc b/tests/Core/positive/test007.jvc
index 3aea6fa70b..45be90b850 100644
--- a/tests/Core/positive/test007.jvc
+++ b/tests/Core/positive/test007.jvc
@@ -1,5 +1,8 @@
 -- case
 
+constr nil 0;
+constr cons 2;
+
 def hd := \x case x of { cons x' _ -> x' };
 def tl := \x case x of { cons _ x' -> x' };
 def null := \x case x of { nil -> true; _ -> false };
diff --git a/tests/Core/positive/test023.jvc b/tests/Core/positive/test023.jvc
index d945c3eb6b..6f2d644d32 100644
--- a/tests/Core/positive/test023.jvc
+++ b/tests/Core/positive/test023.jvc
@@ -1,5 +1,8 @@
 -- lists
 
+constr nil 0;
+constr cons 2;
+
 def head := \l case l of { cons h _ -> h };
 def tail := \l case l of { cons _ t -> t };
 def null := \l case l of { nil -> true; cons _ _ -> false };
diff --git a/tests/Core/positive/test024.jvc b/tests/Core/positive/test024.jvc
index 9e76a97909..3985c13f1d 100644
--- a/tests/Core/positive/test024.jvc
+++ b/tests/Core/positive/test024.jvc
@@ -1,5 +1,8 @@
 -- structural equality
 
+constr nil 0;
+constr cons 2;
+
 def writeLn := \x write x >> write "\n";
 
 writeLn (1 = 1) >>
diff --git a/tests/Core/positive/test028.jvc b/tests/Core/positive/test028.jvc
index e5b1da93af..ac6c683e34 100644
--- a/tests/Core/positive/test028.jvc
+++ b/tests/Core/positive/test028.jvc
@@ -1,5 +1,8 @@
 -- functional queues
 
+constr nil 0;
+constr cons 2;
+
 def hd := \l case l of { cons x _ -> x };
 def tl := \l case l of { cons _ x -> x };
 
diff --git a/tests/Core/positive/test030.jvc b/tests/Core/positive/test030.jvc
index bfa1b44568..744aefbc76 100644
--- a/tests/Core/positive/test030.jvc
+++ b/tests/Core/positive/test030.jvc
@@ -1,5 +1,8 @@
 -- streams without memoization
 
+constr nil 0;
+constr cons 2;
+
 def force := \f f nil;
 
 def filter := \p \s \_
diff --git a/tests/Core/positive/test033.jvc b/tests/Core/positive/test033.jvc
index 39c6b55913..b1c4308625 100644
--- a/tests/Core/positive/test033.jvc
+++ b/tests/Core/positive/test033.jvc
@@ -1,5 +1,8 @@
 -- nested lists
 
+constr nil 0;
+constr cons 2;
+
 def mklst := \n if n = 0 then nil else cons n (mklst (n - 1));
 def mklst2 := \n if n = 0 then nil else cons (mklst n) (mklst2 (n - 1));
 
diff --git a/tests/Core/positive/test035.jvc b/tests/Core/positive/test035.jvc
index 5196b82666..d3d357438b 100644
--- a/tests/Core/positive/test035.jvc
+++ b/tests/Core/positive/test035.jvc
@@ -1,5 +1,8 @@
 -- merge sort
 
+constr nil 0;
+constr cons 2;
+
 constr pair 2;
 
 def length := \xs case xs of {
@@ -15,8 +18,8 @@ def split := \n \xs
       nil -> pair nil nil;
       cons x xs' ->
         case split (n - 1) xs' of {
-	  pair l1 l2 -> pair (cons x l1) l2
-	}
+          pair l1 l2 -> pair (cons x l1) l2
+        }
     };
 
 def merge := \xs \ys case xs of {
diff --git a/tests/Core/positive/test037.jvc b/tests/Core/positive/test037.jvc
index 3cc9ea2844..648b6d69ca 100644
--- a/tests/Core/positive/test037.jvc
+++ b/tests/Core/positive/test037.jvc
@@ -1,5 +1,7 @@
 -- global variables
 
+constr nil 0;
+
 def x := 3 + 4;
 
 def f := \y x;
diff --git a/tests/Core/positive/test039.jvc b/tests/Core/positive/test039.jvc
index 46ae565e76..3256c1e3a6 100644
--- a/tests/Core/positive/test039.jvc
+++ b/tests/Core/positive/test039.jvc
@@ -1,5 +1,7 @@
 -- eta-expansion of builtins and constructors
 
+constr cons 2;
+
 def f := \g g 2;
 def f' := \x f (+ x);
 

From 10ee3cfd36c7f009719396a2a04828995dba2d43 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Mon, 29 Aug 2022 10:04:22 +0200
Subject: [PATCH 82/85] remove if, use builtin constructors for true, false

---
 src/Juvix/Compiler/Core/Evaluator.hs          | 10 +++------
 src/Juvix/Compiler/Core/Extra/Base.hs         | 10 +++------
 src/Juvix/Compiler/Core/Language.hs           | 11 ----------
 src/Juvix/Compiler/Core/Language/Builtins.hs  |  6 ++++--
 src/Juvix/Compiler/Core/Pretty/Base.hs        | 21 ++-----------------
 .../Compiler/Core/Translation/FromSource.hs   | 12 +++--------
 .../Core/Translation/FromSource/Lexer.hs      | 11 ----------
 7 files changed, 15 insertions(+), 66 deletions(-)

diff --git a/src/Juvix/Compiler/Core/Evaluator.hs b/src/Juvix/Compiler/Core/Evaluator.hs
index 988a91fc4f..a7966d9991 100644
--- a/src/Juvix/Compiler/Core/Evaluator.hs
+++ b/src/Juvix/Compiler/Core/Evaluator.hs
@@ -69,11 +69,6 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
         case eval' env v of
           Constr _ tag args -> branch n env args tag def bs
           v' -> evalError "matching on non-data" (substEnv env (Case i v' bs def))
-      If i v b1 b2 ->
-        case eval' env v of
-          Constant _ (ConstBool True) -> eval' env b1
-          Constant _ (ConstBool False) -> eval' env b2
-          v' -> evalError "conditional branch on a non-boolean" (substEnv env (If i v' b1 b2))
       Pi {} -> substEnv env n -- this might need to be implemented more efficiently later
       Univ {} -> n
       TypeApp i sym args -> TypeApp i sym (map (eval' env) args)
@@ -111,7 +106,8 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
     nodeFromInteger !int = Constant Info.empty (ConstInteger int)
 
     nodeFromBool :: Bool -> Node
-    nodeFromBool !b = Constant Info.empty (ConstBool b)
+    nodeFromBool True = Constr Info.empty (BuiltinTag TagTrue) []
+    nodeFromBool False = Constr Info.empty (BuiltinTag TagFalse) []
 
     integerFromNode :: Node -> Integer
     integerFromNode = \case
@@ -151,7 +147,7 @@ hEvalIO hin hout ctx env node =
         _ ->
           return node'
   where
-    unitNode = Constr (Info.singleton (NoDisplayInfo ())) (BuiltinTag TagVoid) []
+    unitNode = Constr (Info.singleton (NoDisplayInfo ())) (BuiltinTag TagTrue) []
 
 evalIO :: IdentContext -> Env -> Node -> IO Node
 evalIO = hEvalIO stdin stdout
diff --git a/src/Juvix/Compiler/Core/Extra/Base.hs b/src/Juvix/Compiler/Core/Extra/Base.hs
index 199308a41b..166c4f88db 100644
--- a/src/Juvix/Compiler/Core/Extra/Base.hs
+++ b/src/Juvix/Compiler/Core/Extra/Base.hs
@@ -18,6 +18,9 @@ unfoldType' ty = case ty of
 {------------------------------------------------------------------------}
 {- functions on Node -}
 
+mkIf :: Info -> Node -> Node -> Node -> Node
+mkIf i v b1 b2 = Case i v [CaseBranch (BuiltinTag TagTrue) 0 b1] (Just b2)
+
 mkApp' :: Node -> [(Info, Node)] -> Node
 mkApp' = foldl' (\acc (i, n) -> App i acc n)
 
@@ -120,13 +123,6 @@ destruct = \case
             )
             (Just (hd (tl args')))
       )
-  If i v b1 b2 ->
-    NodeDetails
-      i
-      [v, b1, b2]
-      [0, 0, 0]
-      [Nothing, Nothing, Nothing]
-      (\i' args' -> If i' (hd args') (args' !! 1) (args' !! 2))
   Pi i ty b ->
     NodeDetails i [ty, b] [0, 1] [Nothing, fetchBinderInfo i] (\i' args' -> Pi i' (hd args') (args' !! 1))
   Univ i l ->
diff --git a/src/Juvix/Compiler/Core/Language.hs b/src/Juvix/Compiler/Core/Language.hs
index 7325fca141..5079422b04 100644
--- a/src/Juvix/Compiler/Core/Language.hs
+++ b/src/Juvix/Compiler/Core/Language.hs
@@ -57,14 +57,6 @@ data Node
         caseBranches :: ![CaseBranch],
         caseDefault :: !(Maybe Node)
       }
-  | -- Lazy `if` on booleans. It is reasonable to separate booleans from general
-    -- datatypes for the purposes of evaluation and code generation.
-    If
-      { ifInfo :: !Info,
-        ifValue :: !Node,
-        ifTrueBranch :: !Node,
-        ifFalseBranch :: !Node
-      }
   | -- Dependent Pi-type. Compilation-time only.
     Pi {piInfo :: !Info, piType :: !Type, piBody :: !Type}
   | -- Universe. Compilation-time only.
@@ -84,7 +76,6 @@ data Node
 
 data ConstantValue
   = ConstInteger !Integer
-  | ConstBool !Bool
   | ConstString !Text
   deriving stock (Eq)
 
@@ -126,7 +117,6 @@ instance HasAtomicity Node where
     Lambda {} -> Aggregate lambdaFixity
     Let {} -> Aggregate lambdaFixity
     Case {} -> Aggregate lambdaFixity
-    If {} -> Aggregate lambdaFixity
     Pi {} -> Aggregate lambdaFixity
     Univ {} -> Atom
     TypeApp {} -> Aggregate appFixity
@@ -146,7 +136,6 @@ instance Eq Node where
   Lambda _ b1 == Lambda _ b2 = b1 == b2
   Let _ v1 b1 == Let _ v2 b2 = v1 == v2 && b1 == b2
   Case _ v1 bs1 def1 == Case _ v2 bs2 def2 = v1 == v2 && bs1 == bs2 && def1 == def2
-  If _ v1 tb1 fb1 == If _ v2 tb2 fb2 = v1 == v2 && tb1 == tb2 && fb1 == fb2
   Pi _ ty1 b1 == Pi _ ty2 b2 = ty1 == ty2 && b1 == b2
   Univ _ l1 == Univ _ l2 = l1 == l2
   TypeApp _ sym1 args1 == TypeApp _ sym2 args2 = sym1 == sym2 && args1 == args2
diff --git a/src/Juvix/Compiler/Core/Language/Builtins.hs b/src/Juvix/Compiler/Core/Language/Builtins.hs
index 1d7785810f..4a8cef7472 100644
--- a/src/Juvix/Compiler/Core/Language/Builtins.hs
+++ b/src/Juvix/Compiler/Core/Language/Builtins.hs
@@ -19,7 +19,8 @@ data BuiltinOp
 
 -- Builtin data tags
 data BuiltinDataTag
-  = TagVoid
+  = TagTrue
+  | TagFalse
   | TagReturn
   | TagBind
   | TagWrite
@@ -43,7 +44,8 @@ builtinOpArgsNum = \case
 
 builtinConstrArgsNum :: BuiltinDataTag -> Int
 builtinConstrArgsNum = \case
-  TagVoid -> 0
+  TagTrue -> 0
+  TagFalse -> 0
   TagReturn -> 1
   TagBind -> 2
   TagWrite -> 1
diff --git a/src/Juvix/Compiler/Core/Pretty/Base.hs b/src/Juvix/Compiler/Core/Pretty/Base.hs
index b12551f9b3..0409eca146 100644
--- a/src/Juvix/Compiler/Core/Pretty/Base.hs
+++ b/src/Juvix/Compiler/Core/Pretty/Base.hs
@@ -50,7 +50,8 @@ instance PrettyCode BuiltinOp where
 
 instance PrettyCode BuiltinDataTag where
   ppCode = \case
-    TagVoid -> return $ annotate (AnnKind KNameConstructor) (pretty ("void" :: String))
+    TagTrue -> return $ annotate (AnnKind KNameConstructor) (pretty ("true" :: String))
+    TagFalse -> return $ annotate (AnnKind KNameConstructor) (pretty ("false" :: String))
     TagReturn -> return $ annotate (AnnKind KNameConstructor) (pretty ("return" :: String))
     TagBind -> return $ annotate (AnnKind KNameConstructor) (pretty ("bind" :: String))
     TagWrite -> return $ annotate (AnnKind KNameConstructor) (pretty ("write" :: String))
@@ -78,10 +79,6 @@ instance PrettyCode Node where
         Nothing -> return $ kwUnnamedIdent <> pretty identSymbol
     Constant _ (ConstInteger int) ->
       return $ annotate AnnLiteralInteger (pretty int)
-    Constant _ (ConstBool True) ->
-      return $ annotate (AnnKind KNameConstructor) (pretty ("true" :: String))
-    Constant _ (ConstBool False) ->
-      return $ annotate (AnnKind KNameConstructor) (pretty ("false" :: String))
     Constant _ (ConstString txt) ->
       return $ annotate AnnLiteralString (pretty (show txt :: String))
     App {..} -> do
@@ -140,11 +137,6 @@ instance PrettyCode Node where
           Nothing -> return bs'
       let bss = bracesIndent $ align $ concatWith (\a b -> a <> kwSemicolon <> line <> b) bs''
       return $ kwCase <+> v <+> kwOf <+> bss
-    If {..} -> do
-      v <- ppCode ifValue
-      b1 <- ppCode ifTrueBranch
-      b2 <- ppCode ifFalseBranch
-      return $ kwIf <+> v <+> kwThen <+> b1 <+> kwElse <+> b2
     Pi {..} ->
       case Info.lookup kBinderInfo piInfo of
         Just bi -> do
@@ -253,15 +245,6 @@ kwOf = keyword Str.of_
 kwDefault :: Doc Ann
 kwDefault = keyword Str.underscore
 
-kwIf :: Doc Ann
-kwIf = keyword Str.if_
-
-kwThen :: Doc Ann
-kwThen = keyword Str.then_
-
-kwElse :: Doc Ann
-kwElse = keyword Str.else_
-
 kwPi :: Doc Ann
 kwPi = keyword Str.pi_
 
diff --git a/src/Juvix/Compiler/Core/Translation/FromSource.hs b/src/Juvix/Compiler/Core/Translation/FromSource.hs
index 6a288c9f0d..5acbe02d37 100644
--- a/src/Juvix/Compiler/Core/Translation/FromSource.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromSource.hs
@@ -92,6 +92,8 @@ declareBuiltins :: Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r
 declareBuiltins = do
   loc <- curLoc
   let i = mkInterval loc loc
+  lift $ declareBuiltinConstr TagTrue "true" i
+  lift $ declareBuiltinConstr TagFalse "false" i
   lift $ declareBuiltinConstr TagReturn "return" i
   lift $ declareBuiltinConstr TagBind "bind" i
   lift $ declareBuiltinConstr TagWrite "write" i
@@ -462,7 +464,6 @@ atom ::
 atom varsNum vars =
   exprNamed varsNum vars
     <|> exprConstInt
-    <|> exprConstBool
     <|> exprConstString
     <|> exprLambda varsNum vars
     <|> exprLet varsNum vars
@@ -502,13 +503,6 @@ exprConstInt = P.try $ do
   (n, i) <- integer
   return $ Constant (Info.singleton (LocationInfo i)) (ConstInteger n)
 
-exprConstBool ::
-  Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
-  ParsecS r Node
-exprConstBool = P.try $ do
-  (b, i) <- boolean
-  return $ Constant (Info.singleton (LocationInfo i)) (ConstBool b)
-
 exprConstString ::
   Members '[Reader ParserParams, InfoTableBuilder, NameIdGen] r =>
   ParsecS r Node
@@ -667,4 +661,4 @@ exprIf varsNum vars = do
   br1 <- expr varsNum vars
   kwElse
   br2 <- expr varsNum vars
-  return $ If Info.empty value br1 br2
+  return $ mkIf Info.empty value br1 br2
diff --git a/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs b/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs
index d29ac7b791..9c8aab6fc1 100644
--- a/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs
@@ -34,9 +34,6 @@ number = number' integer
 string :: Member (Reader ParserParams) r => ParsecS r (Text, Interval)
 string = lexemeInterval string'
 
-boolean :: Member (Reader ParserParams) r => ParsecS r (Bool, Interval)
-boolean = interval (kwTrue >> return True) <|> interval (kwFalse >> return False)
-
 keyword :: Text -> ParsecS r ()
 keyword = keyword' space
 
@@ -66,8 +63,6 @@ allKeywords =
     kwIf,
     kwThen,
     kwElse,
-    kwTrue,
-    kwFalse,
     kwDef,
     kwMapsTo,
     kwRightArrow,
@@ -143,12 +138,6 @@ kwThen = keyword Str.then_
 kwElse :: ParsecS r ()
 kwElse = keyword Str.else_
 
-kwTrue :: ParsecS r ()
-kwTrue = keyword Str.true_
-
-kwFalse :: ParsecS r ()
-kwFalse = keyword Str.false_
-
 kwDef :: ParsecS r ()
 kwDef = keyword Str.def
 

From f7e8d1f156e0a82515245bfe9b16292271ed85a8 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Mon, 29 Aug 2022 12:41:30 +0200
Subject: [PATCH 83/85] refactor: use underscore in field names

---
 src/Juvix/Compiler/Core/Evaluator.hs          |  2 +-
 src/Juvix/Compiler/Core/Extra/Base.hs         |  4 +-
 src/Juvix/Compiler/Core/Language.hs           | 58 +++++++++--------
 src/Juvix/Compiler/Core/Pretty/Base.hs        | 62 +++++++++----------
 src/Juvix/Compiler/Core/Transformation/Eta.hs | 10 +--
 5 files changed, 70 insertions(+), 66 deletions(-)

diff --git a/src/Juvix/Compiler/Core/Evaluator.hs b/src/Juvix/Compiler/Core/Evaluator.hs
index a7966d9991..25a44d4717 100644
--- a/src/Juvix/Compiler/Core/Evaluator.hs
+++ b/src/Juvix/Compiler/Core/Evaluator.hs
@@ -71,7 +71,7 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
           v' -> evalError "matching on non-data" (substEnv env (Case i v' bs def))
       Pi {} -> substEnv env n -- this might need to be implemented more efficiently later
       Univ {} -> n
-      TypeApp i sym args -> TypeApp i sym (map (eval' env) args)
+      TypeConstr i sym args -> TypeConstr i sym (map (eval' env) args)
       Closure {} -> n
 
     branch :: Node -> Env -> [Node] -> Tag -> Maybe Node -> [CaseBranch] -> Node
diff --git a/src/Juvix/Compiler/Core/Extra/Base.hs b/src/Juvix/Compiler/Core/Extra/Base.hs
index 166c4f88db..84412d6369 100644
--- a/src/Juvix/Compiler/Core/Extra/Base.hs
+++ b/src/Juvix/Compiler/Core/Extra/Base.hs
@@ -127,8 +127,8 @@ destruct = \case
     NodeDetails i [ty, b] [0, 1] [Nothing, fetchBinderInfo i] (\i' args' -> Pi i' (hd args') (args' !! 1))
   Univ i l ->
     NodeDetails i [] [] [] (\i' _ -> Univ i' l)
-  TypeApp i sym args ->
-    NodeDetails i args (map (const 0) args) (map (const Nothing) args) (`TypeApp` sym)
+  TypeConstr i sym args ->
+    NodeDetails i args (map (const 0) args) (map (const Nothing) args) (`TypeConstr` sym)
   Closure i env b ->
     NodeDetails
       i
diff --git a/src/Juvix/Compiler/Core/Language.hs b/src/Juvix/Compiler/Core/Language.hs
index 5079422b04..47240a6898 100644
--- a/src/Juvix/Compiler/Core/Language.hs
+++ b/src/Juvix/Compiler/Core/Language.hs
@@ -24,12 +24,12 @@ import Juvix.Compiler.Core.Language.Base
 -- node.
 data Node
   = -- De Bruijn index of a locally bound variable.
-    Var {varInfo :: !Info, varIndex :: !Index}
+    Var {_varInfo :: !Info, _varIndex :: !Index}
   | -- Global identifier of a function (with corresponding `Node` in the global
     -- context).
-    Ident {identInfo :: !Info, identSymbol :: !Symbol}
-  | Constant {constantInfo :: !Info, constantValue :: !ConstantValue}
-  | App {appInfo :: !Info, appLeft :: !Node, appRight :: !Node}
+    Ident {_identInfo :: !Info, _identSymbol :: !Symbol}
+  | Constant {_constantInfo :: !Info, _constantValue :: !ConstantValue}
+  | App {_appInfo :: !Info, _appLeft :: !Node, _appRight :: !Node}
   | -- A builtin application. A builtin has no corresponding Node. It is treated
     -- specially by the evaluator and the code generator. For example, basic
     -- arithmetic operations go into `Builtin`. The number of arguments supplied
@@ -37,37 +37,41 @@ data Node
     -- operation (this simplifies evaluation and code generation). If you need
     -- partial application, eta-expand with lambdas, e.g., eta-expand `(+) 2` to
     -- `\x -> (+) 2 x`. See Transformation/Eta.hs.
-    BuiltinApp {builtinInfo :: !Info, builtinOp :: !BuiltinOp, builtinArgs :: ![Node]}
+    BuiltinApp {_builtinInfo :: !Info, _builtinOp :: !BuiltinOp, _builtinArgs :: ![Node]}
   | -- A data constructor application. The number of arguments supplied must be
     -- equal to the number of arguments expected by the constructor.
     Constr
-      { constrInfo :: !Info,
-        constrTag :: !Tag,
-        constrArgs :: ![Node]
+      { _constrInfo :: !Info,
+        _constrTag :: !Tag,
+        _constrArgs :: ![Node]
       }
-  | Lambda {lambdaInfo :: !Info, lambdaBody :: !Node}
+  | Lambda {_lambdaInfo :: !Info, _lambdaBody :: !Node}
   | -- `let x := value in body` is not reducible to lambda + application for the purposes
     -- of ML-polymorphic / dependent type checking or code generation!
-    Let {letInfo :: !Info, letValue :: !Node, letBody :: !Node}
+    Let {_letInfo :: !Info, _letValue :: !Node, _letBody :: !Node}
   | -- One-level case matching on the tag of a data constructor: `Case value
     -- branches default`. `Case` is lazy: only the selected branch is evaluated.
     Case
-      { caseInfo :: !Info,
-        caseValue :: !Node,
-        caseBranches :: ![CaseBranch],
-        caseDefault :: !(Maybe Node)
+      { _caseInfo :: !Info,
+        _caseValue :: !Node,
+        _caseBranches :: ![CaseBranch],
+        _caseDefault :: !(Maybe Node)
       }
-  | -- Dependent Pi-type. Compilation-time only.
-    Pi {piInfo :: !Info, piType :: !Type, piBody :: !Type}
+  | -- Dependent Pi-type. Compilation-time only. Pi implicitly introduces a binder
+    -- in the body, exactly like Lambda. So `Pi info ty body` is `Pi x : ty .
+    -- body` in more familiar notation, but references to `x` in `body` are via de
+    -- Bruijn index. For example, Pi A : Type . A -> A translates to (omitting
+    -- Infos): Pi (Univ level) (Pi (Var 0) (Var 1)).
+    Pi {_piInfo :: !Info, _piType :: !Type, _piBody :: !Type}
   | -- Universe. Compilation-time only.
-    Univ {univInfo :: !Info, univLevel :: !Int}
-  | -- Type application. Compilation-time only.
-    TypeApp {typeInfo :: !Info, typeSymbol :: !Symbol, typeArgs :: ![Type]}
+    Univ {_univInfo :: !Info, _univLevel :: !Int}
+  | -- Type constructor application. Compilation-time only.
+    TypeConstr {_typeConstrInfo :: !Info, _typeConstrSymbol :: !Symbol, _typeConstrArgs :: ![Type]}
   | -- Evaluation only: `Closure env body`
     Closure
-      { closureInfo :: !Info,
-        closureEnv :: !Env,
-        closureBody :: !Node
+      { _closureInfo :: !Info,
+        _closureEnv :: !Env,
+        _closureBody :: !Node
       }
 
 -- Other things we might need in the future:
@@ -85,7 +89,7 @@ data ConstantValue
 -- `CaseBranch tag argsNum branch`
 -- - `argsNum` is the number of arguments of the constructor tagged with `tag`,
 --   equal to the number of implicit binders above `branch`
-data CaseBranch = CaseBranch {caseTag :: !Tag, caseBindersNum :: !Int, caseBranch :: !Node}
+data CaseBranch = CaseBranch {_caseTag :: !Tag, _caseBindersNum :: !Int, _caseBranch :: !Node}
   deriving stock (Eq)
 
 -- A node (term) is closed if it has no free variables, i.e., no de Bruijn
@@ -110,16 +114,16 @@ instance HasAtomicity Node where
     Ident {} -> Atom
     Constant {} -> Atom
     App {} -> Aggregate appFixity
-    BuiltinApp {..} | null builtinArgs -> Atom
+    BuiltinApp {..} | null _builtinArgs -> Atom
     BuiltinApp {} -> Aggregate lambdaFixity
-    Constr {..} | null constrArgs -> Atom
+    Constr {..} | null _constrArgs -> Atom
     Constr {} -> Aggregate lambdaFixity
     Lambda {} -> Aggregate lambdaFixity
     Let {} -> Aggregate lambdaFixity
     Case {} -> Aggregate lambdaFixity
     Pi {} -> Aggregate lambdaFixity
     Univ {} -> Atom
-    TypeApp {} -> Aggregate appFixity
+    TypeConstr {} -> Aggregate appFixity
     Closure {} -> Aggregate lambdaFixity
 
 lambdaFixity :: Fixity
@@ -138,6 +142,6 @@ instance Eq Node where
   Case _ v1 bs1 def1 == Case _ v2 bs2 def2 = v1 == v2 && bs1 == bs2 && def1 == def2
   Pi _ ty1 b1 == Pi _ ty2 b2 = ty1 == ty2 && b1 == b2
   Univ _ l1 == Univ _ l2 = l1 == l2
-  TypeApp _ sym1 args1 == TypeApp _ sym2 args2 = sym1 == sym2 && args1 == args2
+  TypeConstr _ sym1 args1 == TypeConstr _ sym2 args2 = sym1 == sym2 && args1 == args2
   Closure _ env1 b1 == Closure _ env2 b2 = env1 == env2 && b1 == b2
   _ == _ = False
diff --git a/src/Juvix/Compiler/Core/Pretty/Base.hs b/src/Juvix/Compiler/Core/Pretty/Base.hs
index 0409eca146..5e0ce254ff 100644
--- a/src/Juvix/Compiler/Core/Pretty/Base.hs
+++ b/src/Juvix/Compiler/Core/Pretty/Base.hs
@@ -65,36 +65,36 @@ instance PrettyCode Tag where
 instance PrettyCode Node where
   ppCode node = case node of
     Var {..} ->
-      case Info.lookup kNameInfo varInfo of
+      case Info.lookup kNameInfo _varInfo of
         Just ni -> do
           showDeBruijn <- asks (^. optShowDeBruijnIndices)
           n <- ppCode (ni ^. NameInfo.infoName)
           if showDeBruijn
-            then return $ n <> kwDeBruijnVar <> pretty varIndex
+            then return $ n <> kwDeBruijnVar <> pretty _varIndex
             else return n
-        Nothing -> return $ kwDeBruijnVar <> pretty varIndex
+        Nothing -> return $ kwDeBruijnVar <> pretty _varIndex
     Ident {..} ->
-      case Info.lookup kNameInfo identInfo of
+      case Info.lookup kNameInfo _identInfo of
         Just ni -> ppCode (ni ^. NameInfo.infoName)
-        Nothing -> return $ kwUnnamedIdent <> pretty identSymbol
+        Nothing -> return $ kwUnnamedIdent <> pretty _identSymbol
     Constant _ (ConstInteger int) ->
       return $ annotate AnnLiteralInteger (pretty int)
     Constant _ (ConstString txt) ->
       return $ annotate AnnLiteralString (pretty (show txt :: String))
     App {..} -> do
-      l' <- ppLeftExpression appFixity appLeft
-      r' <- ppRightExpression appFixity appRight
+      l' <- ppLeftExpression appFixity _appLeft
+      r' <- ppRightExpression appFixity _appRight
       return $ l' <+> r'
     BuiltinApp {..} -> do
-      args' <- mapM (ppRightExpression appFixity) builtinArgs
-      op' <- ppCode builtinOp
+      args' <- mapM (ppRightExpression appFixity) _builtinArgs
+      op' <- ppCode _builtinOp
       return $ foldl (<+>) op' args'
     Constr {..} -> do
-      args' <- mapM (ppRightExpression appFixity) constrArgs
+      args' <- mapM (ppRightExpression appFixity) _constrArgs
       n' <-
-        case Info.lookup kNameInfo constrInfo of
+        case Info.lookup kNameInfo _constrInfo of
           Just ni -> ppCode (ni ^. NameInfo.infoName)
-          Nothing -> ppCode constrTag
+          Nothing -> ppCode _constrTag
       return $ foldl (<+>) n' args'
     Lambda {} -> do
       let (infos, body) = unfoldLambdas' node
@@ -111,26 +111,26 @@ instance PrettyCode Node where
             Nothing -> return $ kwLambda <> kwQuestion
     Let {..} -> do
       n' <-
-        case Info.lookup kBinderInfo letInfo of
+        case Info.lookup kBinderInfo _letInfo of
           Just bi -> ppCode (bi ^. BinderInfo.infoName)
           Nothing -> return kwQuestion
-      v' <- ppCode letValue
-      b' <- ppCode letBody
+      v' <- ppCode _letValue
+      b' <- ppCode _letBody
       return $ kwLet <+> n' <+> kwAssign <+> v' <+> kwIn <+> b'
     Case {..} -> do
       bns <-
-        case Info.lookup kCaseBinderInfo caseInfo of
+        case Info.lookup kCaseBinderInfo _caseInfo of
           Just ci -> mapM (mapM (ppCode . (^. BinderInfo.infoName))) (ci ^. infoBranchBinders)
-          Nothing -> mapM (\(CaseBranch _ n _) -> replicateM n (return kwQuestion)) caseBranches
+          Nothing -> mapM (\(CaseBranch _ n _) -> replicateM n (return kwQuestion)) _caseBranches
       cns <-
-        case Info.lookup kCaseBranchInfo caseInfo of
+        case Info.lookup kCaseBranchInfo _caseInfo of
           Just ci -> mapM (ppCode . (^. BranchInfo.infoTagName)) (ci ^. infoBranches)
-          Nothing -> mapM (\(CaseBranch tag _ _) -> ppCode tag) caseBranches
-      let bs = map (\(CaseBranch _ _ br) -> br) caseBranches
-      v <- ppCode caseValue
+          Nothing -> mapM (\(CaseBranch tag _ _) -> ppCode tag) _caseBranches
+      let bs = map (\(CaseBranch _ _ br) -> br) _caseBranches
+      v <- ppCode _caseValue
       bs' <- sequence $ zipWith3Exact (\cn bn br -> ppCode br >>= \br' -> return $ foldl (<+>) cn bn <+> kwMapsto <+> br') cns bns bs
       bs'' <-
-        case caseDefault of
+        case _caseDefault of
           Just def -> do
             d' <- ppCode def
             return $ bs' ++ [kwDefault <+> kwMapsto <+> d']
@@ -138,25 +138,25 @@ instance PrettyCode Node where
       let bss = bracesIndent $ align $ concatWith (\a b -> a <> kwSemicolon <> line <> b) bs''
       return $ kwCase <+> v <+> kwOf <+> bss
     Pi {..} ->
-      case Info.lookup kBinderInfo piInfo of
+      case Info.lookup kBinderInfo _piInfo of
         Just bi -> do
           n <- ppCode (bi ^. BinderInfo.infoName)
-          b <- ppCode piBody
+          b <- ppCode _piBody
           return $ kwLambda <> n <+> b
         Nothing -> do
-          b <- ppCode piBody
+          b <- ppCode _piBody
           return $ kwLambda <> kwQuestion <+> b
     Univ {..} ->
-      return $ kwType <+> pretty univLevel
-    TypeApp {..} -> do
-      args' <- mapM (ppRightExpression appFixity) typeArgs
+      return $ kwType <+> pretty _univLevel
+    TypeConstr {..} -> do
+      args' <- mapM (ppRightExpression appFixity) _typeConstrArgs
       n' <-
-        case Info.lookup kNameInfo typeInfo of
+        case Info.lookup kNameInfo _typeConstrInfo of
           Just ni -> ppCode (ni ^. NameInfo.infoName)
-          Nothing -> return $ kwUnnamedIdent <> pretty typeSymbol
+          Nothing -> return $ kwUnnamedIdent <> pretty _typeConstrSymbol
       return $ foldl (<+>) n' args'
     Closure {..} ->
-      ppCode (substEnv closureEnv (Lambda closureInfo closureBody))
+      ppCode (substEnv _closureEnv (Lambda _closureInfo _closureBody))
 
 instance PrettyCode a => PrettyCode (NonEmpty a) where
   ppCode x = do
diff --git a/src/Juvix/Compiler/Core/Transformation/Eta.hs b/src/Juvix/Compiler/Core/Transformation/Eta.hs
index a8e76fc0cf..99f6f2b722 100644
--- a/src/Juvix/Compiler/Core/Transformation/Eta.hs
+++ b/src/Juvix/Compiler/Core/Transformation/Eta.hs
@@ -14,8 +14,8 @@ etaExpandBuiltins = umap go
     go :: Node -> Node
     go n = case n of
       BuiltinApp {..}
-        | builtinOpArgsNum builtinOp > length builtinArgs ->
-            etaExpand (builtinOpArgsNum builtinOp - length builtinArgs) n
+        | builtinOpArgsNum _builtinOp > length _builtinArgs ->
+            etaExpand (builtinOpArgsNum _builtinOp - length _builtinArgs) n
       _ -> n
 
 etaExpandConstrs :: (Tag -> Int) -> Node -> Node
@@ -24,10 +24,10 @@ etaExpandConstrs argsNum = umap go
     go :: Node -> Node
     go n = case n of
       Constr {..}
-        | k > length constrArgs ->
-            etaExpand (k - length constrArgs) n
+        | k > length _constrArgs ->
+            etaExpand (k - length _constrArgs) n
         where
-          k = argsNum constrTag
+          k = argsNum _constrTag
       _ -> n
 
 squashApps :: Node -> Node

From 0fd5d1f43195583df74e6d39c1946b6b09a9d672 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Mon, 29 Aug 2022 12:42:24 +0200
Subject: [PATCH 84/85] remove stupid comment

---
 src/Juvix/Compiler/Core/Evaluator.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Juvix/Compiler/Core/Evaluator.hs b/src/Juvix/Compiler/Core/Evaluator.hs
index 25a44d4717..75c3ca97c0 100644
--- a/src/Juvix/Compiler/Core/Evaluator.hs
+++ b/src/Juvix/Compiler/Core/Evaluator.hs
@@ -69,7 +69,7 @@ eval !ctx !env0 = convertRuntimeNodes . eval' env0
         case eval' env v of
           Constr _ tag args -> branch n env args tag def bs
           v' -> evalError "matching on non-data" (substEnv env (Case i v' bs def))
-      Pi {} -> substEnv env n -- this might need to be implemented more efficiently later
+      Pi {} -> substEnv env n
       Univ {} -> n
       TypeConstr i sym args -> TypeConstr i sym (map (eval' env) args)
       Closure {} -> n

From d0a3c968268735e58adf82cb15c35fad9ebf122f Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Mon, 29 Aug 2022 12:47:31 +0200
Subject: [PATCH 85/85] change foldl to foldl'

---
 src/Juvix/Compiler/Core/Pretty/Base.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/src/Juvix/Compiler/Core/Pretty/Base.hs b/src/Juvix/Compiler/Core/Pretty/Base.hs
index 5e0ce254ff..9f3b069e20 100644
--- a/src/Juvix/Compiler/Core/Pretty/Base.hs
+++ b/src/Juvix/Compiler/Core/Pretty/Base.hs
@@ -88,19 +88,19 @@ instance PrettyCode Node where
     BuiltinApp {..} -> do
       args' <- mapM (ppRightExpression appFixity) _builtinArgs
       op' <- ppCode _builtinOp
-      return $ foldl (<+>) op' args'
+      return $ foldl' (<+>) op' args'
     Constr {..} -> do
       args' <- mapM (ppRightExpression appFixity) _constrArgs
       n' <-
         case Info.lookup kNameInfo _constrInfo of
           Just ni -> ppCode (ni ^. NameInfo.infoName)
           Nothing -> ppCode _constrTag
-      return $ foldl (<+>) n' args'
+      return $ foldl' (<+>) n' args'
     Lambda {} -> do
       let (infos, body) = unfoldLambdas' node
       pplams <- mapM ppLam infos
       b <- ppCode body
-      return $ foldl (flip (<+>)) b pplams
+      return $ foldl' (flip (<+>)) b pplams
       where
         ppLam :: Member (Reader Options) r => Info -> Sem r (Doc Ann)
         ppLam i =
@@ -128,7 +128,7 @@ instance PrettyCode Node where
           Nothing -> mapM (\(CaseBranch tag _ _) -> ppCode tag) _caseBranches
       let bs = map (\(CaseBranch _ _ br) -> br) _caseBranches
       v <- ppCode _caseValue
-      bs' <- sequence $ zipWith3Exact (\cn bn br -> ppCode br >>= \br' -> return $ foldl (<+>) cn bn <+> kwMapsto <+> br') cns bns bs
+      bs' <- sequence $ zipWith3Exact (\cn bn br -> ppCode br >>= \br' -> return $ foldl' (<+>) cn bn <+> kwMapsto <+> br') cns bns bs
       bs'' <-
         case _caseDefault of
           Just def -> do
@@ -154,7 +154,7 @@ instance PrettyCode Node where
         case Info.lookup kNameInfo _typeConstrInfo of
           Just ni -> ppCode (ni ^. NameInfo.infoName)
           Nothing -> return $ kwUnnamedIdent <> pretty _typeConstrSymbol
-      return $ foldl (<+>) n' args'
+      return $ foldl' (<+>) n' args'
     Closure {..} ->
       ppCode (substEnv _closureEnv (Lambda _closureInfo _closureBody))