From d57e621c5b2d444d648733c6c2fe06853e454a7e Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Tue, 16 Jul 2024 13:40:27 +0200
Subject: [PATCH 01/44] Add file structure

---
 lib/haskell/natural4/natural4.cabal                   | 3 +++
 lib/haskell/natural4/src/LS/XPile/Simala/Log.hs       | 1 +
 lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs | 4 ++++
 lib/haskell/natural4/src/LS/XPile/Simala/Types.hs     | 1 +
 4 files changed, 9 insertions(+)
 create mode 100644 lib/haskell/natural4/src/LS/XPile/Simala/Log.hs
 create mode 100644 lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
 create mode 100644 lib/haskell/natural4/src/LS/XPile/Simala/Types.hs

diff --git a/lib/haskell/natural4/natural4.cabal b/lib/haskell/natural4/natural4.cabal
index 7c4ca5b89..6c43a0569 100644
--- a/lib/haskell/natural4/natural4.cabal
+++ b/lib/haskell/natural4/natural4.cabal
@@ -106,6 +106,9 @@ library
       LS.XPile.Petri
       LS.XPile.Prolog
       LS.XPile.Purescript
+      LS.XPile.Simala.Log
+      LS.XPile.Simala.Transpile
+      LS.XPile.Simala.Types
       LS.XPile.SVG
       LS.XPile.Typescript
       LS.XPile.Uppaal
diff --git a/lib/haskell/natural4/src/LS/XPile/Simala/Log.hs b/lib/haskell/natural4/src/LS/XPile/Simala/Log.hs
new file mode 100644
index 000000000..5a150e98f
--- /dev/null
+++ b/lib/haskell/natural4/src/LS/XPile/Simala/Log.hs
@@ -0,0 +1 @@
+module LS.XPile.Simala.Log where
diff --git a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
new file mode 100644
index 000000000..2b9f98739
--- /dev/null
+++ b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
@@ -0,0 +1,4 @@
+module LS.XPile.Simala.Transpile where
+
+
+-- transpileToSimala :: Interpreter -> 
diff --git a/lib/haskell/natural4/src/LS/XPile/Simala/Types.hs b/lib/haskell/natural4/src/LS/XPile/Simala/Types.hs
new file mode 100644
index 000000000..4a09294a8
--- /dev/null
+++ b/lib/haskell/natural4/src/LS/XPile/Simala/Types.hs
@@ -0,0 +1 @@
+module LS.XPile.Simala.Types where

From c0d2a41b62957f6373f338e72a26083b50351a45 Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Thu, 18 Jul 2024 10:20:11 +0200
Subject: [PATCH 02/44] WIP: simala backend

---
 lib/haskell/cabal.project                     |   1 +
 lib/haskell/example-progs.md                  | 329 +++++++
 lib/haskell/hie.yaml                          |  38 +-
 lib/haskell/natural4/bnfc/Main.hs             |  54 +-
 lib/haskell/natural4/natural4.cabal           |  16 +
 lib/haskell/natural4/package.yaml             |   3 +
 lib/haskell/natural4/src/LS/Interpreter.hs    |  12 +-
 lib/haskell/natural4/src/LS/Logger.hs         |   2 +
 .../natural4/src/LS/RelationalPredicates.hs   |   2 +
 lib/haskell/natural4/src/LS/Renamer.hs        | 706 ++++++++++++++
 lib/haskell/natural4/src/LS/Types.hs          |  26 +-
 lib/haskell/natural4/src/LS/XPile/Common.hs   |  39 +
 .../GenericMathLang/GenericMathLangAST.hs     |  32 +-
 .../GenericMathLang/ToGenericMathLang.hs      |  11 +-
 .../MathLang/GenericMathLang/TranslateL4.hs   |  18 +-
 .../src/LS/XPile/MathLang/MathLang.hs         |   3 +-
 .../natural4/src/LS/XPile/Simala/Transpile.hs | 889 +++++++++++++++++-
 .../natural4/src/LS/XPile/Simala/Types.hs     |   1 +
 lib/haskell/natural4/test/LS/RenamerSpec.hs   |  77 ++
 lib/haskell/natural4/test/PAUs.csv            |   4 +-
 .../golden/decide-with-attributes.expected    |   1 +
 .../test/testdata/golden/id-func.expected     |   1 +
 lib/haskell/questions.md                      |  15 -
 lib/haskell/stack.yaml                        |   1 +
 24 files changed, 2163 insertions(+), 118 deletions(-)
 create mode 100644 lib/haskell/example-progs.md
 create mode 100644 lib/haskell/natural4/src/LS/Logger.hs
 create mode 100644 lib/haskell/natural4/src/LS/Renamer.hs
 create mode 100644 lib/haskell/natural4/src/LS/XPile/Common.hs
 create mode 100644 lib/haskell/natural4/test/LS/RenamerSpec.hs
 create mode 100644 lib/haskell/natural4/test/testdata/golden/decide-with-attributes.expected
 create mode 100644 lib/haskell/natural4/test/testdata/golden/id-func.expected
 delete mode 100644 lib/haskell/questions.md

diff --git a/lib/haskell/cabal.project b/lib/haskell/cabal.project
index 3c923f4fc..a8aea9856 100644
--- a/lib/haskell/cabal.project
+++ b/lib/haskell/cabal.project
@@ -2,6 +2,7 @@ packages:
   ./natural4
   ./anyall
   ./explainable
+  ../../../simala
 
 -- Environment files are required to run the doctests via `cabal test doctests`
 write-ghc-environment-files: always
diff --git a/lib/haskell/example-progs.md b/lib/haskell/example-progs.md
new file mode 100644
index 000000000..ed987975c
--- /dev/null
+++ b/lib/haskell/example-progs.md
@@ -0,0 +1,329 @@
+# Discuss and look at various hornlike rules
+
+* What's the rule-name for?
+* How is the rule-name determined?
+
+## Functions and constants
+
+```
+GIVEN d DECIDE g d IS y
+WHERE
+    y's book IS green IF d > 0;
+    y's book IS red OTHERWISE
+```
+
+Simple function
+Corresponds to the function:
+
+> g :: Int -> { book: 'red | 'green }
+> g d = if d > 0 then { book: green} else { book: red }
+
+Or the simala function:
+
+> g = fun (d) => if d > 0 then { book = 'green } else { book = 'red }
+
+**Question**
+
+Is this function equivalent? Or is this a constant?
+
+```
+GIVEN d
+GIVETH y
+DECIDE
+    y's book IS green IF d > 0;
+    y's book's size IS g z OTHERWISE
+WHERE
+    z IS 5
+    g d IS 5
+
+
+GIVETH d
+DECIDE d IS 5;
+```
+
+The generic mathlang translation seems to turn this one into:
+
+```
+[ param d, param y.green, param y.red
+, y = true
+, if d > 0 then y.book = green
+, if true then y.book = red
+]
+```
+
+In short, this shouldn't work, as this rule doesn't have a name and is thus unusable.
+
+Or is `y` a global variable? It can't be in this instance, but what about
+
+```
+GIVETH y
+DECIDE y
+WHERE
+    y's book IS green IF d > 0;
+    y's book IS red OTHERWISE
+```
+
+Would that be supposed to work?
+
+**ANSWER**
+
+As `d` can be inferred as a global variable, we are thinking of a new keyword, such as `WITH` or `ASSUME`.
+
+```
+ASSUME d
+GIVETH y
+WHERE
+    y's book IS 'green IF d > 0;
+    y's book IS 'red OTHERWISE
+```
+
+Translates to:
+
+> let d = ... : Int
+> in let y = if d > 0 then { book: 'green } else { book: 'red }
+
+### Declarations
+
+**Valid definition**
+
+Prefix (1 arg)
+
+```
+GIVEN x
+DECIDE f x IS SUM(x, 3)
+```
+
+Postfix
+
+```
+GIVEN x
+DECIDE x f IS SUM(x, 3)
+```
+
+Prefix (2 args)
+
+```
+GIVEN x, y
+DECIDE f x y IS SUM(x, 3)
+```
+
+Infix (2 args)
+
+```
+GIVEN x, y
+DECIDE x f y IS SUM(x, 3)
+```
+
+**Invalid definition**
+
+`y` is bound in where, that's not allowed.
+
+```
+GIVEN x
+DECIDE f x y IS SUM(x, y)
+WHERE y IS 5
+```
+
+`d` is a global variable, not allowed in function definition
+
+```
+GIVEN x
+DECIDE f x d IS SUM(x, d)
+```
+
+
+## GIVEN and GIVETHS
+
+```
+GIVETH x, y
+DECIDE
+    x IS 5;
+    y IS 7
+```
+
+Is this two constants, or what is this supposed to mean?
+
+`GIVEN`s seem to be generally rather optional, are they simply variable declarations?
+
+**ANSWER**
+
+These are indeed two constants.
+
+## Name shadowing
+
+**In bnfc, rules are not allowed in WHERE**
+
+```
+GIVEN x IS A NUMBER
+DECIDE g x IS f x
+WHERE
+    GIVEN x DECIDE f x IS SUM(x, x)
+```
+
+## Functions
+
+Functions are of the form
+
+```
+GIVEN x [AS A type], y [IS ONE OF ...], ...
+DECIDE f x y ... IS <body>
+```
+
+As a concrete example
+
+```
+GIVEN x
+DECIDE f x IS 5
+```
+
+`f` is the function name, `x` the parameter and `5` is the function body.
+So the function `f` called with any parameter produces the result `5`.
+
+All parameters *must* be `GIVEN`s and occur on the lhs of `IS`.
+The name of the function, which must be free can occur for single parameters in
+either `Prefix` or `Postfix`, and for two parameters in `Prefix` or `Infix` notation.
+For anything else, the function must be in `Prefix` notation.
+
+E.g.
+
+* `f x`: Prefix
+* `x f`: Postfix
+* `x f y`: Infix
+* `f x y`: Prefix
+* `f a b c d ...`: Prefix.
+
+### Recursion
+
+Possible example:
+
+```
+GIVEN x
+DECIDE
+    f x IS SUM ( f MINUS ( x , 1 ) , f MINUS ( x , 1 ) ) IF x > 0;
+    f x IS 0 OTHERWISE
+```
+
+However, this fail to parse and the equivalent csv syntax also feels like it would not support this.
+
+## Inline Enums for GIVEN and GIVETH
+
+```
+GIVETH x IS ONE OF foo, bar, baz DECIDE x IS foo
+```
+
+Assign that x is some output
+
+> x :: foo | bar | baz
+> x = foo
+
+```
+GIVEN
+    y IS A NUMBER
+GIVETH
+    x IS ONE OF foo, bar, baz
+DECIDE
+    x IS foo IF y > 5;
+    x IS bar IF y < 0;
+    x IS baz OTHERWISE
+```
+
+Assign a value to the variable x based on the value of 'y'
+Should translate to:
+
+> x = \y -> if y > 5 then 'foo else if y < 0 then 'bar else 'baz
+
+```
+GIVEN x IS ONE OF foo, bar, baz
+DECIDE
+    foo x IS 5 IF x IS foo;
+    foo x IS 10 OTHERWISE
+```
+
+Assign that x is some output
+
+    foo :: foo | bar | baz -> Number
+    foo x = if x == foo
+           then 5
+           else 10
+
+```
+GIVEN x IS ONE OF foo, bar, baz;
+      y IS ONE OF foo, bar, baz
+DECIDE
+    foo x IS 5 IF x IS foo AND y IS foo;
+    foo x IS 10 OTHERWISE
+```
+
+Are x and y referring to the same type?
+What about:
+
+```
+GIVEN x IS ONE OF foo, bar, baz
+      y IS ONE OF foo, bar, foo baz
+```
+
+Are 'foo and 'bar the same type then?
+For now, enums can only be text and they are assumed to be globals.
+
+E.g., this is disallowed
+
+```
+GIVEN x IS ONE OF foo IS A NUMBER;
+      bar IS A NUMBER
+DECIDE f x IS 5
+```
+
+# Renaming
+
+How do we want to rename a program?
+Example programs:
+
+**Id Function**
+
+```
+GIVEN x
+DECIDE id x IS x
+```
+
+```
+GIVEN x1
+DECIDE id1 x1 IS x1
+```
+
+**Multiple Id Functions**
+
+```
+§ fun_0
+GIVEN x
+DECIDE id x IS x
+
+§ fun_1
+GIVEN x
+DECIDE id2 x IS x
+```
+
+```
+GIVEN x1
+DECIDE id1 x1 IS x1
+
+GIVEN x2
+DECIDE id12 x2 IS x2
+```
+
+Note, `id1` is renamed to `id12`.
+`GIVEN`s are renamed as they are local to the function.
+
+Scope Tree
+
+```
+* (1) id
+    * (2) x
+* (3) id
+    * (4) x
+```
+
+```
+* 1 (id)
+    * x
+* 2 (id)
+    *
diff --git a/lib/haskell/hie.yaml b/lib/haskell/hie.yaml
index b98f2901d..9caecb69d 100644
--- a/lib/haskell/hie.yaml
+++ b/lib/haskell/hie.yaml
@@ -1,37 +1,3 @@
 cradle:
-  stack:
-    - path: "anyall/src"
-      component: "anyall:lib"
-
-    - path: "anyall/app/"
-      component: "anyall:exe:anyall-exe"
-
-    - path: "anyall/test"
-      component: "anyall:test:anyall-test"
-
-    - path: "explainable/src"
-      component: "explainable:lib"
-
-    - path: "explainable/app/"
-      component: "explainable:exe:explainable-exe"
-
-    - path: "explainable/test"
-      component: "explainable:test:explainable-test"
-
-    - path: "natural4/src"
-      component: "natural4:lib"
-
-    - path: "natural4/app"
-      component: "natural4:exe:natural4-exe"
-
-    - path: "natural4/test/doctests"
-      component: "natural4:test:doctests"
-
-    - path: "natural4/test"
-      component: "natural4:test:natural4-test"
-
-    - path: "natural4/benchmarks"
-      component: "natural4:bench:natural4-bench"
-
-    - path: "natural4/bnfc"
-      component: "natural4:exe:l4-bnfc-exe"
+  cabal:
+    component: all
diff --git a/lib/haskell/natural4/bnfc/Main.hs b/lib/haskell/natural4/bnfc/Main.hs
index 45c3ae1a1..4b9b0ef82 100644
--- a/lib/haskell/natural4/bnfc/Main.hs
+++ b/lib/haskell/natural4/bnfc/Main.hs
@@ -1,21 +1,30 @@
 -- File generated by the BNF Converter (bnfc 2.9.5).
 
 -- | Program to test parser.
-
 module Main where
 
-import System.Exit        ( exitFailure )
-import Control.Monad      ( when )
+import Control.Monad (forM_, when)
+import Data.Function ((&))
+import Data.HashMap.Strict qualified as HM
+import Data.List (uncons)
 import Data.Text.Lazy qualified as Text
+import Explainable
+import Explainable.MathLang
+import Explainable.MathLang qualified as Expl
+import LS.Rule (Interpreted (origrules), defaultL4I)
+import LS.XPile.MathLang.GenericMathLang.ToGenericMathLang
+import LS.XPile.MathLang.MathLang qualified as GML
+import System.Environment (getArgs)
+import System.Exit (exitFailure)
+import Text.Pretty.Simple (pShowNoColor)
 import TextuaL4.AbsTextuaL qualified as TL4
+import TextuaL4.LexTextuaL (Token, mkPosToken)
+import TextuaL4.ParTextuaL (myLexer, pRule)
 import TextuaL4.Transform
-import TextuaL4.LexTextuaL   ( Token, mkPosToken )
-import TextuaL4.ParTextuaL   ( pRule, myLexer )
-import Text.Pretty.Simple (pShowNoColor)
 
-type Err        = Either String
+type Err = Either String
 type ParseFun a = [Token] -> Err a
-type Verbosity  = Int
+type Verbosity = Int
 
 putStrV :: Verbosity -> String -> IO ()
 putStrV v s = when (v > 1) $ putStrLn s
@@ -36,16 +45,35 @@ run v p s =
       let l4tree = transRule tree
       putStrLn $ Text.unpack $ pShowNoColor l4tree
 
+
+      when (v >= 3) $ do
+        let
+          stuff = toMathLangGen $ defaultL4I{origrules = [l4tree]}
+          (stuff2, st0) = GML.toMathLang $ defaultL4I{origrules = [l4tree]}
+          st =
+            st0
+              { symtabF =
+                  symtabF st0
+                    & HM.insert "green" (Expl.Val Nothing 1.0)
+                    & HM.insert "red" (Expl.Val Nothing 2.0)
+                    & HM.insert "d" (Expl.Val Nothing 15.0)
+              }
+        putStrLn $ fst stuff
+        forM_ stuff2 $ \explExpr -> do
+          xplainE (mempty @()) st $ eval explExpr
+        pure ()
  where
   ts = myLexer s
-  showPosToken ((l,c),t) = concat [ show l, ":", show c, "\t", show t ]
+  showPosToken ((l, c), t) = concat [show l, ":", show c, "\t", show t]
 
 showTree :: (Show a) => Int -> a -> IO ()
 showTree v tree = do
   putStrV v $ "\n[Abstract Syntax]\n\n" ++ show tree
 
-
 main :: IO ()
-main = getContents >>= run 2 pRule
-
-
+main = do
+  xs <- getArgs
+  let v = case uncons xs of
+        Nothing -> 2
+        Just (x, _) -> read x
+  getContents >>= run v pRule
diff --git a/lib/haskell/natural4/natural4.cabal b/lib/haskell/natural4/natural4.cabal
index 6c43a0569..771db4d58 100644
--- a/lib/haskell/natural4/natural4.cabal
+++ b/lib/haskell/natural4/natural4.cabal
@@ -34,12 +34,14 @@ library
       LS.Error
       LS.Interpreter
       LS.Lib
+      LS.Logger
       LS.NLP.NL4
       LS.NLP.NL4Transformations
       LS.NLP.NLG
       LS.Parser
       LS.PrettyPrinter
       LS.RelationalPredicates
+      LS.Renamer
       LS.Rule
       LS.Tokens
       LS.TokenTable
@@ -49,6 +51,7 @@ library
       LS.Utils.TextUtils
       LS.Utils.UtilsREPLDev
       LS.Verdict
+      LS.XPile.Common
       LS.XPile.CoreL4
       LS.XPile.CoreL4.LogicProgram
       LS.XPile.CoreL4.LogicProgram.Common
@@ -134,6 +137,7 @@ library
     , boxes
     , bytestring
     , cassava
+    , co-log-core
     , containers
     , deque
     , diagnose
@@ -178,6 +182,7 @@ library
     , recursion-schemes
     , safe
     , safe-money
+    , simala
     , split
     , string-conversions
     , string-interpolate
@@ -210,6 +215,7 @@ executable l4-bnfc-exe
     , boxes
     , bytestring
     , cassava
+    , co-log-core
     , containers
     , deque
     , diagnose
@@ -254,6 +260,7 @@ executable l4-bnfc-exe
     , recursion-schemes
     , safe
     , safe-money
+    , simala
     , split
     , string-conversions
     , string-interpolate
@@ -286,6 +293,7 @@ executable natural4-exe
     , boxes
     , bytestring
     , cassava
+    , co-log-core
     , containers
     , deque
     , diagnose
@@ -330,6 +338,7 @@ executable natural4-exe
     , recursion-schemes
     , safe
     , safe-money
+    , simala
     , split
     , string-conversions
     , string-interpolate
@@ -363,6 +372,7 @@ test-suite doctests
     , boxes
     , bytestring
     , cassava
+    , co-log-core
     , containers
     , deque
     , diagnose
@@ -408,6 +418,7 @@ test-suite doctests
     , recursion-schemes
     , safe
     , safe-money
+    , simala
     , split
     , string-conversions
     , string-interpolate
@@ -430,6 +441,7 @@ test-suite natural4-test
       LS.InterpreterSpec
       LS.NLGSpec
       LS.RelationalPredicatesSpec
+      LS.RenamerSpec
       LS.TextuaL4Spec
       LS.TypesSpec
       LS.XPile.CoreL4.LogicProgramSpec
@@ -465,6 +477,7 @@ test-suite natural4-test
     , boxes
     , bytestring
     , cassava
+    , co-log-core
     , containers
     , deque
     , diagnose
@@ -513,6 +526,7 @@ test-suite natural4-test
     , recursion-schemes
     , safe
     , safe-money
+    , simala
     , split
     , string-conversions
     , string-interpolate
@@ -547,6 +561,7 @@ benchmark natural4-bench
     , boxes
     , bytestring
     , cassava
+    , co-log-core
     , containers
     , criterion
     , deepseq
@@ -593,6 +608,7 @@ benchmark natural4-bench
     , recursion-schemes
     , safe
     , safe-money
+    , simala
     , split
     , string-conversions
     , string-interpolate
diff --git a/lib/haskell/natural4/package.yaml b/lib/haskell/natural4/package.yaml
index 5ce95cb6a..361888a75 100644
--- a/lib/haskell/natural4/package.yaml
+++ b/lib/haskell/natural4/package.yaml
@@ -25,6 +25,7 @@ description: natural4 parses a Legal Spreadsheet's CSV and transpiles to multipl
 dependencies:
   - base >= 4.7 && < 5
   - containers
+  - co-log-core
   - unordered-containers
   - hashable
   - flow
@@ -95,6 +96,8 @@ dependencies:
   # - holmes
 # Note: when adding `extra-deps` in `stack.yaml`, have to add them under the relevant package in `package.yaml` too
 # See https://docs.haskellstack.org/en/stable/stack_yaml_vs_cabal_package_file/#why-specify-dependencies-twice
+  # Dependencies specific to the WIP simala backend
+  - simala
 
 language: GHC2021
 
diff --git a/lib/haskell/natural4/src/LS/Interpreter.hs b/lib/haskell/natural4/src/LS/Interpreter.hs
index 73237482b..db7d687eb 100644
--- a/lib/haskell/natural4/src/LS/Interpreter.hs
+++ b/lib/haskell/natural4/src/LS/Interpreter.hs
@@ -975,7 +975,7 @@ extractRPMT2Text _         =
 type RuleSet = [Rule]
 
 -- * the getRuleBy* family
--- 
+--
 -- | Retrieve a rule by name, using `ruleName`
 getRuleByName :: RuleSet -> RuleName -> Maybe Rule
 getRuleByName rs rn = find (\r -> ruleName r == rn) rs
@@ -1089,7 +1089,7 @@ globalFacts l4i = do
           pure $ Node pt []
       }
 
--- * Extract everything that looks like a method.
+-- | Extract everything that looks like a method.
 --
 -- A common form is:
 -- @
@@ -1097,14 +1097,14 @@ globalFacts l4i = do
 --           ClassA's RecordAttr's AttributeName IS baz WHEN quux
 --           ClassA's RecordAttr's AttributeName IS baz OTHERWISE
 -- @
--- 
+--
 -- Extract and return all of these decisions in the form:
 --
 -- @
 --    [([ClassA, RecordAttr, AttributeName], foo, Just bar
 -- @
--- 
--- | we extract the methods to a fully qualified and annotatable form defined as `ValuePredicate` -- see Types.hs
+--
+-- we extract the methods to a fully qualified and annotatable form defined as `ValuePredicate` -- see Types.hs
 --
 -- Go through every rule and break it down into this structure.
 
@@ -1160,7 +1160,7 @@ attrsAsMethods rs = do
           xpError ["unhandled RelationalPredicate", show hHead]
 
 -- | input: [MTT "foo's", MTT "bar's", MTT "baz"]
--- 
+--
 --  output: (["foo", "bar"], "baz")
 toObjectPath :: MultiTerm -> XPileLogE ([EntityName], EntityName)
 toObjectPath [] = do
diff --git a/lib/haskell/natural4/src/LS/Logger.hs b/lib/haskell/natural4/src/LS/Logger.hs
new file mode 100644
index 000000000..e57a6db0c
--- /dev/null
+++ b/lib/haskell/natural4/src/LS/Logger.hs
@@ -0,0 +1,2 @@
+module LS.Logger where
+
diff --git a/lib/haskell/natural4/src/LS/RelationalPredicates.hs b/lib/haskell/natural4/src/LS/RelationalPredicates.hs
index 380d96b54..8523ccb8b 100644
--- a/lib/haskell/natural4/src/LS/RelationalPredicates.hs
+++ b/lib/haskell/natural4/src/LS/RelationalPredicates.hs
@@ -4,6 +4,8 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RecordWildCards #-}
 
+{-# OPTIONS_GHC -Wall #-}
+
 {-|
 This module provides parser and utility functions for the RelationalPredicate group of types.
 
diff --git a/lib/haskell/natural4/src/LS/Renamer.hs b/lib/haskell/natural4/src/LS/Renamer.hs
new file mode 100644
index 000000000..7fc12bbdc
--- /dev/null
+++ b/lib/haskell/natural4/src/LS/Renamer.hs
@@ -0,0 +1,706 @@
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wall #-}
+
+module LS.Renamer where
+
+import AnyAll.BoolStruct qualified as AA
+import L4.Lexer qualified as Parser
+import LS.Rule (Rule, RuleLabel)
+import LS.Rule qualified as Rule
+import LS.Types (MyToken, RuleName, SrcRef)
+import LS.Types qualified as LS
+import TextuaL4.ParTextuaL qualified as Parser
+import TextuaL4.Transform qualified as Parser
+
+import Control.Monad.Error.Class
+import Control.Monad.Extra (fromMaybeM)
+import Control.Monad.State.Class qualified as State
+import Control.Monad.State.Strict (MonadState)
+import Control.Monad.Trans.Except qualified as Except
+import Control.Monad.Trans.State.Strict qualified as State (runState)
+import Data.List.NonEmpty (NonEmpty)
+import Data.List.NonEmpty qualified as NE
+import Data.Map.Strict (Map)
+import Data.Map.Strict qualified as Map
+import Data.Set qualified as Set
+import Data.Text (Text)
+import Data.Text qualified as Text
+import Data.Text.Lazy.IO qualified as TL
+import Debug.Trace (traceShowId)
+import GHC.Generics (Generic)
+import Optics
+import Text.Pretty.Simple qualified as Pretty
+
+-- ----------------------------------------------------------------------------
+-- Types specific to the renamer phase
+-- ----------------------------------------------------------------------------
+
+-- | A rename rule is the same as a 'Rule' but
+data RnRule
+  = Hornlike RnHornlike
+  deriving (Eq, Ord, Show, Generic)
+
+type RnBoolStructR = AA.OptionallyLabeledBoolStruct RnRelationalPredicate
+
+data RnHornClause = RnHornClause
+  { rnHcHead :: RnRelationalPredicate
+  , rnHcBody :: Maybe RnBoolStructR
+  }
+  deriving (Eq, Ord, Show, Generic)
+
+type RnRuleName = RnMultiTerm
+
+data RnHornlike = RnHornlike
+  { name :: RnRuleName -- MyInstance
+  , super :: Maybe RnTypeSig -- IS A Superclass
+  , keyword :: MyToken -- decide / define / means
+  , given :: Maybe RnParamText -- a:Applicant, p:Person, l:Lender       -- the type signature of the input
+  , giveth :: Maybe RnParamText -- m:Amount,   mp:Principal, mi:Interest -- the type signature of the output
+  , upon :: Maybe RnParamText -- second request occurs
+  , clauses :: [RnHornClause] -- colour IS blue WHEN fee > $10 ; colour IS green WHEN fee > $20 AND approver IS happy
+  , rlabel :: Maybe RuleLabel
+  , lsource :: Maybe Text
+  , wwhere :: [RnRule]
+  , srcref :: Maybe SrcRef
+  , defaults :: [RnRelationalPredicate] -- SomeConstant IS 500 ; MentalCapacity TYPICALLY True
+  , symtab :: [RnRelationalPredicate] -- SomeConstant IS 500 ; MentalCapacity TYPICALLY True
+  }
+  deriving (Eq, Ord, Show, Generic)
+
+type RnEntityType = RnName
+
+data RnTypeSig
+  = RnSimpleType LS.ParamType RnEntityType
+  | RnInlineEnum LS.ParamType RnParamText
+  deriving (Eq, Ord, Show, Generic)
+
+newtype RnParamText = RnParamText
+  { mkParamText :: NonEmpty RnTypedMulti
+  }
+  deriving (Eq, Ord, Show, Generic)
+
+data RnTypedMulti = RnTypedMulti
+  { rnTypedMultiExpr :: NonEmpty RnExpr
+  , rnTypedMultiTypeSig :: Maybe RnTypeSig
+  }
+  deriving (Eq, Ord, Show, Generic)
+
+-- | A name is something that can be resolved as either a variable, function, or enum.
+data RnName = RnName
+  { rnOccName :: OccName
+  , rnUniqueId :: Unique
+  , rnNameType :: RnNameType
+  -- TODO: add the binding scope for scope checking
+  -- , rnBindingScope :: BindingScope
+  }
+  deriving (Eq, Ord, Show, Generic)
+
+data RnNameType
+  = RnSelector
+  | RnFunction
+  | RnVariable
+  | RnType
+  | RnEnum
+  | RnBuiltin
+  deriving (Eq, Ord, Show, Generic)
+
+data RnExpr
+  = RnExprName RnName
+  | RnExprLit RnLit
+  deriving (Eq, Ord, Show, Generic)
+
+data RnLit
+  = RnInt Integer
+  | RnDouble Double
+  | RnBool Bool
+  deriving (Eq, Ord, Show, Generic)
+
+type RnMultiTerm = [RnExpr]
+
+data RnRelationalPredicate
+  = -- | Might be something like a record access.
+    RnRelationalTerm RnMultiTerm
+  | RnConstraint RnMultiTerm LS.RPRel RnMultiTerm
+  | RnBoolStructR RnMultiTerm LS.RPRel RnBoolStructR
+  | RnNary LS.RPRel [RnRelationalPredicate]
+  deriving (Eq, Ord, Show, Generic)
+
+-- ----------------------------------------------------------------------------
+-- Scope tables
+-- ----------------------------------------------------------------------------
+
+type StVariable = Text
+type Unique = Int
+type OccName = NonEmpty LS.MTExpr
+type FuncOccName = Text
+
+data FuncInfo = FuncInfo
+  { funcArity :: (Int, Int)
+  -- ^ Arity of a function. The first component means how many parameters
+  -- are allowed before the function, the second component how many parameters
+  -- are allowed afterwards.
+  -- For example @(1, 1)@ is a simple infix function of the form @x f y@ where @f@
+  -- is the name of the function.
+  }
+  deriving (Eq, Ord, Show)
+
+mkSimpleOccName :: Text -> OccName
+mkSimpleOccName = NE.singleton . LS.MTT
+
+data Scope = Scope
+  { _scScopeTable :: ScopeTable
+  , _scUnique :: Unique
+  }
+  deriving (Eq, Ord, Show)
+
+data BindingScope
+  = ToplevelScope
+  | WhereScope
+  | GivenScope
+  | GivethScope
+  deriving (Eq, Ord, Show)
+
+data ScopeTable = ScopeTable
+  { _stVariables :: Map OccName RnName
+  , _stFunction :: Map FuncOccName FuncInfo
+  }
+  deriving (Eq, Ord, Show)
+
+makeFieldsNoPrefix 'Scope
+makeFieldsNoPrefix 'ScopeTable
+
+emptyScope :: Scope
+emptyScope =
+  Scope
+    { _scScopeTable =
+        ScopeTable
+          { _stVariables = Map.empty
+          , _stFunction = Map.empty
+          }
+    , _scUnique = 0
+    }
+
+prefixScope :: RuleName -> Scope -> Scope
+prefixScope = undefined
+
+newUniqueM :: (MonadState Scope m) => m Unique
+newUniqueM = do
+  u <- State.gets _scUnique
+  State.modify' (\s -> s & scUnique %~ (+ 1))
+  pure u
+
+lookupName :: (MonadState Scope m) => OccName -> m (Maybe RnName)
+lookupName occName = do
+  st <- State.gets _scScopeTable
+  pure $ Map.lookup occName (_stVariables st)
+
+lookupOrInsertName :: (MonadState Scope m, MonadError String m) => OccName -> RnNameType -> m RnName
+lookupOrInsertName occName nameType = do
+  lookupName occName >>= \case
+    Nothing -> insertName occName nameType
+    Just name
+      | rnNameType name == nameType -> pure name
+      | otherwise ->
+          throwError $
+            "lookupOrInsertName: Invariant violated, trying to insert a different name type for a name that's already known. Got: "
+              <> show nameType
+              <> " but expected: "
+              <> show (rnNameType name)
+
+insertName :: (MonadState Scope m) => OccName -> RnNameType -> m RnName
+insertName occName nameType = do
+  n <- newUniqueM
+  -- TODO: error handling, would we accept an enum such as `a IS ONE OF 1, 2, 3`?
+  -- Only if we treat them as text, which might be confusing, as user might infer
+  -- this to be some kind of type checked number type.
+  let
+    rnName =
+      RnName
+        { rnUniqueId = n
+        , rnOccName = occName
+        , rnNameType = nameType
+        }
+  State.modify' $ \(s :: Scope) ->
+    s
+      & scScopeTable
+      % stVariables
+      % at occName
+      .~ Just rnName
+  pure rnName
+
+insertFunction :: (MonadState Scope m) => FuncOccName -> FuncInfo -> m ()
+insertFunction funcOccName funcInfo = do
+  State.modify' $ \s ->
+    s
+      & scScopeTable
+      % stFunction
+      % at funcOccName
+      .~ Just funcInfo
+
+lookupFunction :: (MonadState Scope m) => FuncOccName -> m (Maybe FuncInfo)
+lookupFunction funcOccName =
+  State.gets $ \s ->
+    s ^. scScopeTable % stFunction % at funcOccName
+
+-- ----------------------------------------------------------------------------
+-- Top Level Definitions
+-- ----------------------------------------------------------------------------
+
+renameRuleTopLevel :: Rule -> IO ()
+renameRuleTopLevel rule = do
+  TL.putStrLn $ Pretty.pShow rule
+  let
+    (res, s) = renameRuleTopLevel' rule
+  TL.putStrLn $ Pretty.pShow s
+  case res of
+    Left err -> putStrLn err
+    Right rnRule -> TL.putStrLn $ Pretty.pShow rnRule
+
+renameRuleTopLevel' :: Rule -> (Either String RnRule, Scope)
+renameRuleTopLevel' rule =
+  State.runState (Except.runExceptT (renameRule rule)) emptyScope
+
+-- ----------------------------------------------------------------------------
+-- Resolve functions and their respective arities
+-- ----------------------------------------------------------------------------
+
+-- fixRuleArity :: (MonadState Scope m, MonadError String m) => Rule -> m RnRule
+
+-- ----------------------------------------------------------------------------
+-- Renamer passes
+-- ----------------------------------------------------------------------------
+
+renameRule :: (MonadState Scope m, MonadError String m) => Rule -> m RnRule
+renameRule rule@Rule.Hornlike{} = do
+  super <- traverse renameTypeSignature rule.super
+  given <- renameGivens rule.given
+  giveth <- renameGiveths rule.giveth
+  upons <- renameUpons rule.upon
+  wwhere <- traverse renameRule rule.wwhere
+  defaults <- assertEmptyList rule.defaults
+  symtab <- assertEmptyList rule.symtab
+  clauses <- traverse renameHornClause rule.clauses
+  pure $
+    Hornlike
+      RnHornlike
+        { name = []
+        , super = super
+        , keyword = rule.keyword
+        , given = given
+        , giveth = giveth
+        , upon = upons
+        , clauses = clauses
+        , rlabel = rule.rlabel
+        , lsource = rule.lsource
+        , wwhere = wwhere
+        , srcref = rule.srcref
+        , defaults = defaults
+        , symtab = symtab
+        }
+renameRule r@Rule.Regulative{} = throwError $ "Unsupported rule: " <> show r
+renameRule r@Rule.Constitutive{} = throwError $ "Unsupported rule: " <> show r
+renameRule r@Rule.TypeDecl{} = throwError $ "Unsupported rule: " <> show r
+renameRule r@Rule.Scenario{} = throwError $ "Unsupported rule: " <> show r
+renameRule r@Rule.DefNameAlias{} = throwError $ "Unsupported rule: " <> show r
+renameRule r@Rule.DefTypically{} = throwError $ "Unsupported rule: " <> show r
+renameRule r@Rule.RuleAlias{} = throwError $ "Unsupported rule: " <> show r
+renameRule r@Rule.RuleGroup{} = throwError $ "Unsupported rule: " <> show r
+renameRule r@Rule.RegFulfilled{} = throwError $ "Unsupported rule: " <> show r
+renameRule r@Rule.RegBreach{} = throwError $ "Unsupported rule: " <> show r
+renameRule r@Rule.NotARule{} = throwError $ "Unsupported rule: " <> show r
+
+renameUpons ::
+  forall m.
+  (MonadState Scope m, MonadError String m) =>
+  Maybe LS.ParamText ->
+  m (Maybe RnParamText)
+renameUpons Nothing = pure Nothing
+renameUpons (Just xs) = throwError $ "Unsupported \"UPON\", got: " <> show xs
+
+renameGiveths ::
+  forall m.
+  (MonadState Scope m, MonadError String m) =>
+  Maybe LS.ParamText ->
+  m (Maybe RnParamText)
+renameGiveths = renameGivens
+
+renameGivens ::
+  forall m.
+  (MonadState Scope m, MonadError String m) =>
+  Maybe LS.ParamText ->
+  m (Maybe RnParamText)
+renameGivens Nothing = pure Nothing
+renameGivens (Just givens) = do
+  rnGivens <- mapM renameGiven givens
+  pure $ Just $ RnParamText rnGivens
+ where
+  renameGiven (mtExprs, typeSig) = do
+    rnMtExprs <- renameGivenMultiTerm mtExprs
+    rnTypeSig <- traverse renameTypeSignature typeSig
+    pure $ RnTypedMulti (NE.singleton $ RnExprName rnMtExprs) rnTypeSig
+
+  renameGivenMultiTerm mtExprs = do
+    mt <- assertSingletonMultiTerm mtExprs
+    insertName (pure mt) RnVariable
+
+renameTypeSignature ::
+  forall m.
+  (MonadState Scope m, MonadError String m) =>
+  LS.TypeSig ->
+  m RnTypeSig
+renameTypeSignature sig = case sig of
+  LS.SimpleType pType entityType -> do
+    rnEntityType <- renameEntityType entityType
+    pure $ RnSimpleType pType rnEntityType
+  LS.InlineEnum pType paramText -> do
+    rnParamText <- renameGivenInlineEnumParamText paramText
+    pure $ RnInlineEnum pType rnParamText
+ where
+  renameEntityType :: LS.EntityType -> m RnEntityType
+  renameEntityType eType =
+    -- This is might be a new entity type. However, we allow ad-hoc type definitions.
+    -- Thus, insert a new entity type. This definition defines one name for all
+    -- 'EntityType's with the same name over the whole program.
+    lookupOrInsertName (mkSimpleOccName eType) RnType
+
+  -- Why not reuse 'renameParamText'? It is basically the same type!
+  -- Well, we don't handle arbitrary nested type signatures.
+  -- In fact, it is a bit dubious we have them at all!
+  -- The following seems to be possible in theory:
+  --
+  -- @
+  -- GIVEN x IS ONE OF foo IS ONE OF foobar, foobaz
+  -- @
+  --
+  -- What would that suppose to mean? So, for now, we only allow enum definitions
+  -- to be of the following form:
+  --
+  -- @
+  -- GIVEN x IS ONE OF foo, bar, foo baz
+  -- @
+  --
+  -- This means 'x' is one of three possible enum values 'foo', 'bar'
+  -- and 'foo baz'.
+  --
+  -- TODO: We reuse this for Type declarations as well, are nested type signatures allowed in this case?
+  -- Even in that case, since 'TypeDecl''s 'has' is a list of 'TypeDecl''s, it seems like
+  -- there is no arbitrary nesting.
+  renameGivenInlineEnumParamText :: LS.ParamText -> m RnParamText
+  renameGivenInlineEnumParamText params = do
+    let
+      renameEach tm = do
+        mt <- assertNoTypeSignature tm
+        _t <- assertMultiExprIsOnlyText mt
+        enumName <- insertName mt RnEnum
+        pure $
+          RnTypedMulti
+            { rnTypedMultiExpr = NE.singleton $ RnExprName enumName
+            , rnTypedMultiTypeSig = Nothing
+            }
+
+    rnParams <- mapM renameEach $ traceShowId params
+    pure $ RnParamText rnParams
+
+renameHornClause :: (MonadState Scope m, MonadError String m) => LS.HornClause2 -> m RnHornClause
+renameHornClause hc = do
+  rnHead <- renameDecideHeadClause hc.hHead
+  rnBody <- traverse renameBoolStruct hc.hBody
+  pure $
+    RnHornClause
+      { rnHcHead = rnHead
+      , rnHcBody = rnBody
+      }
+
+renameDecideHeadClause :: (MonadState Scope m, MonadError String m) => LS.RelationalPredicate -> m RnRelationalPredicate
+renameDecideHeadClause = \case
+  LS.RPParamText pText -> throwError $ "Received 'RPParamText', we can't handle that yet. Got: " <> show pText
+  LS.RPMT mt -> RnRelationalTerm <$> renameDecideMultiTerm mt
+  LS.RPConstraint lhs relationalPredicate rhs -> do
+    rnLhs <- renameDecideMultiTerm lhs
+    rnRhs <- renameMultiTerm rhs
+    pure $ RnConstraint rnLhs relationalPredicate rnRhs
+  LS.RPBoolStructR lhs relationalPredicate rhs -> do
+    rnLhs <- renameDecideMultiTerm lhs
+    rnRhs <- renameBoolStruct rhs
+    pure $ RnBoolStructR rnLhs relationalPredicate rnRhs
+  LS.RPnary LS.RPis (lhs : rhs) -> do
+    -- When the assignment has multiple complicated relational predicates,
+    -- it is translated to this 'RPNary'. Then the first element is before the 'IS'
+    -- and the rest after.
+    -- Example:
+    -- @f x IS SUM(x, x, x)@
+    -- is parsed to @RPnary RPis [[f, x], [RPnary RPSum [x, x, x]]]@
+    -- ignoring some details.
+    rnLhs <- renameDecideHeadClause lhs
+    rnRhs <- traverse renameRelationalPredicate rhs
+    pure $ RnNary LS.RPis (rnLhs : rnRhs)
+  LS.RPnary relationalPredicate rhs -> do
+    rnRhs <- traverse renameRelationalPredicate rhs
+    pure $ RnNary relationalPredicate rnRhs
+
+-- | Rename a top-level occurrence of 'LS.MultiTerm'.
+--
+-- This is slightly special, as this may be the definition site of functions.
+--
+-- For now, we accept the following 'LS.MultiTerm''s for function definitions:
+--
+-- * @f x@: function @f@ in prefix with parameter @x@
+-- * @x f@: function @f@ in postfix with parameter @x@
+-- * @f x y@: function @f@ in prefix with parameters @x@ and @y@
+-- * @x f y@: function @f@ in infix with parameters @x@ and @y@
+--
+-- Note, to be recognized as a function, variables must have been specified by 'GIVEN'
+-- clauses and the function name must be unbound in its current scope.
+--
+-- Additionally, we recognize the following forms:
+--
+-- * @f's x's y's z@: An attribute path from @f@ to something that has a @z@ attribute.
+-- * @x@: a variable, might be bound ad-hoc
+--
+-- Note, this doesn't accept literals such as '42' or '3.5f'.
+renameDecideMultiTerm :: (MonadState Scope m, MonadError String m) => LS.MultiTerm -> m RnMultiTerm
+renameDecideMultiTerm mt = do
+  scopeTable <- State.gets _scScopeTable
+  case mt of
+    [] -> throwError "renameDecideMultiTerm: Unexpected empty list of MultiTerm"
+    [LS.MTT x] -> do
+      rnName <- lookupOrInsertName (mkSimpleOccName x) RnVariable
+      pure [RnExprName rnName]
+    [LS.MTT f, LS.MTT x]
+      | Just [rnX] <- variableAndFunction scopeTable [x] f -> do
+          insertFunction f (FuncInfo{funcArity = (0, 1)})
+          rnF <- lookupOrInsertName (mkSimpleOccName f) RnFunction
+          pure $ [RnExprName rnF, RnExprName rnX]
+    [LS.MTT x, LS.MTT f]
+      | Just [rnX] <- variableAndFunction scopeTable [x] f -> do
+          insertFunction f (FuncInfo{funcArity = (1, 0)})
+          rnF <- lookupOrInsertName (mkSimpleOccName f) RnFunction
+          pure $ [RnExprName rnF, RnExprName rnX]
+    [LS.MTT x, LS.MTT f, LS.MTT y]
+      | Just [rnX, rnY] <- variableAndFunction scopeTable [x, y] f -> do
+          insertFunction f (FuncInfo{funcArity = (1, 1)})
+          rnF <- lookupOrInsertName (mkSimpleOccName f) RnFunction
+          pure $ [RnExprName rnF, RnExprName rnX, RnExprName rnY]
+    [LS.MTT f, LS.MTT x, LS.MTT y]
+      | Just [rnX, rnY] <- variableAndFunction scopeTable [x, y] f -> do
+          insertFunction f (FuncInfo{funcArity = (0, 2)})
+          rnF <- lookupOrInsertName (mkSimpleOccName f) RnFunction
+          pure $ [RnExprName rnF, RnExprName rnX, RnExprName rnY]
+    attrs@(_ : _)
+      | Just (obj, objAttrs) <- toObjectPath attrs -> do
+          rnName <- lookupOrInsertName (mkSimpleOccName obj) RnVariable
+          rnObjAttrs <- mapM (\attr -> RnExprName <$> lookupOrInsertName (mkSimpleOccName attr) RnSelector) objAttrs
+          pure $ RnExprName rnName : rnObjAttrs
+    unknownPattern -> throwError $ "While renaming a multi term in a top-level DECIDE clause, we encountered an unsupported pattern: " <> show unknownPattern
+
+-- | Check whether this could be a function like structure.
+--
+-- It might be, if all the variables are already bound, and the function name
+-- is unbound or already known as a function.
+variableAndFunction :: ScopeTable -> [Text] -> Text -> Maybe [RnName]
+variableAndFunction st variables function = do
+  -- TODO: this is wrong, only consider arguments in the GIVEN's, otherwise
+  -- that's name shadowing. E.g.
+  --
+  -- @
+  -- GIVEN x DECIDE f x y IS SUM(x, y) WHERE y IS 5
+  -- @
+  rnBoundVariables <- traverse ((`Map.lookup` _stVariables st) . mkSimpleOccName) variables
+  case mkSimpleOccName function `Map.lookup` _stVariables st of
+    -- The function name must be either unbound, or
+    -- registered as a function.
+    Just fnName
+      | fnName.rnNameType == RnFunction -> Just rnBoundVariables
+      | otherwise -> Nothing
+    Nothing -> Just rnBoundVariables
+
+renameRelationalPredicate :: (MonadState Scope m, MonadError String m) => LS.RelationalPredicate -> m RnRelationalPredicate
+renameRelationalPredicate = \case
+  LS.RPParamText pText -> throwError $ "Received 'RPParamText', we can't handle that yet. Got: " <> show pText
+  LS.RPMT mt -> RnRelationalTerm <$> renameMultiTerm mt
+  LS.RPConstraint lhs relationalPredicate rhs -> do
+    rnLhs <- renameMultiTerm lhs
+    rnRhs <- renameMultiTerm rhs
+    pure $ RnConstraint rnLhs relationalPredicate rnRhs
+  LS.RPBoolStructR lhs relationalPredicate rhs -> do
+    rnLhs <- renameMultiTerm lhs
+    rnRhs <- renameBoolStruct rhs
+    pure $ RnBoolStructR rnLhs relationalPredicate rnRhs
+  LS.RPnary relationalPredicate rhs -> do
+    rnRhs <- traverse renameRelationalPredicate rhs
+    pure $ RnNary relationalPredicate rnRhs
+
+renameBoolStruct :: (MonadState Scope m, MonadError String m) => LS.BoolStructR -> m RnBoolStructR
+renameBoolStruct = \case
+  AA.Leaf p -> AA.Leaf <$> renameRelationalPredicate p
+  AA.All lbl cs -> do
+    rnBoolStruct <- traverse renameBoolStruct cs
+    pure $ AA.All lbl rnBoolStruct
+  AA.Any lbl cs -> do
+    rnBoolStruct <- traverse renameBoolStruct cs
+    pure $ AA.Any lbl rnBoolStruct
+  AA.Not cs -> AA.Not <$> renameBoolStruct cs
+
+renameMultiTerm :: (MonadState Scope m, MonadError String m) => LS.MultiTerm -> m RnMultiTerm
+renameMultiTerm = mapM renameMultiTermExpression
+
+renameMultiTermExpression :: (MonadState Scope m, MonadError String m) => LS.MTExpr -> m RnExpr
+renameMultiTermExpression = \case
+  -- TODO: this could be an expression such as "2+2" (for whatever reason), so perhaps
+  -- we need to parse this further. Allegedly, we also want to support
+  -- expressions nested into one csv-cell, for example:
+  --
+  -- >>> MT "f x y"
+  --
+  -- where 'f' is a function.
+  -- We ignore this for now, though.
+  LS.MTT name -> case isGenitive name of
+    Nothing ->
+      lookupName (mkSimpleOccName name) >>= \case
+        Just rnName -> pure $ RnExprName rnName
+        Nothing
+          | isL4BuiltIn name -> RnExprName <$> rnL4Builtin name
+          | otherwise -> do
+              -- TODO: review, this feels wrong.
+              -- Perhaps renaming without context is simply not possible for an 'MTExpr'?
+              --
+              -- if this is not a known variable, let's assume it is a selector.
+              RnExprName <$> insertName (mkSimpleOccName name) RnSelector
+    Just nameSelector -> do
+      -- Is this name known already?
+      -- If not, we assume this is a selector we haven't encountered before.
+      -- Take for example this function:
+      --
+      -- @
+      --   GIVEN x DECIDE f x IS x's y's z
+      -- @
+      --
+      -- Then 'y' and 'z' are anonymous selectors for 'x'.
+      rnName <- fromMaybeM (lookupOrInsertName (mkSimpleOccName nameSelector) RnSelector) (lookupName (mkSimpleOccName nameSelector))
+      pure $ RnExprName rnName
+  LS.MTI int -> pure $ RnExprLit $ RnInt int
+  LS.MTF double -> pure $ RnExprLit $ RnDouble double
+  LS.MTB bool -> pure $ RnExprLit $ RnBool bool
+
+-- ----------------------------------------------------------------------------
+-- Builtins
+-- ----------------------------------------------------------------------------
+
+isL4BuiltIn :: Text -> Bool
+isL4BuiltIn name = Set.member name (Set.fromList l4Builtins)
+
+rnL4Builtin :: (MonadState Scope m, MonadError String m) => Text -> m RnName
+rnL4Builtin name = do
+  lookupOrInsertName (mkSimpleOccName name) RnBuiltin
+
+l4Builtins :: [Text]
+l4Builtins = [oTHERWISE]
+
+oTHERWISE :: Text
+oTHERWISE = "OTHERWISE"
+
+-- ----------------------------------------------------------------------------
+-- Assertions and helpers.
+-- These allow us to express expectations and clean up the code
+-- by giving us exactly what we need, followed by throwErroring if assumptions are violated.
+-- ----------------------------------------------------------------------------
+
+-- | Assert the collection of 'MTExpr' consists only of text fragments.
+--
+-- TODO: This is lossy, we can't reconstruct the 'NonEmpty LS.MTExpr' given the
+-- text. Fix this! It is likely wrong, too.
+assertMultiExprIsOnlyText :: (MonadError String m) => NonEmpty LS.MTExpr -> m Text
+assertMultiExprIsOnlyText mtt = do
+  xs <- traverse assertExprIsText mtt
+  pure $ Text.unwords $ NE.toList xs
+
+assertSingletonMultiTerm :: (MonadError String m) => NonEmpty LS.MTExpr -> m LS.MTExpr
+assertSingletonMultiTerm (x NE.:| []) = pure x
+assertSingletonMultiTerm xs = throwError $ "Expected singleton but got: " <> show xs
+
+assertMultiExprIsText :: (MonadError String m) => NonEmpty LS.MTExpr -> m Text
+assertMultiExprIsText mts = do
+  mt <- assertSingletonMultiTerm mts
+  assertExprIsText mt
+
+assertExprIsText :: (MonadError String m) => LS.MTExpr -> m Text
+assertExprIsText (LS.MTT t) = pure t
+assertExprIsText mt = throwError $ "Expected MTT but got: " <> show mt
+
+assertNoTypeSignature :: (MonadError String m) => LS.TypedMulti -> m (NonEmpty LS.MTExpr)
+assertNoTypeSignature tm@(_, Just _) = throwError $ "Expected no type signature but got: " <> show tm
+assertNoTypeSignature (mtt, Nothing) = do
+  pure mtt
+
+-- | If we can't handle renaming certain list of things, we just hope that
+-- the parser doesn't give us a list with any elements.
+-- We throwError if the list is not @'null'@.
+assertEmptyList :: (Show a, MonadError String m) => [a] -> m [b]
+assertEmptyList [] = pure []
+assertEmptyList xs = throwError $ "Expected an empty list, but got: " <> show xs
+
+-- ----------------------------------------------------------------------------
+-- Helper utils non specific to the renamer.
+-- Should be moved out into a general purpose function.
+-- ----------------------------------------------------------------------------
+
+-- | Given a 'LS.MultiTerm', check whether it has the form of an attribute
+-- selector.
+--
+-- >>> toObjectPath [LS.MTT "x's", LS.MTT "z"]
+-- Just ("x",["z"])
+--
+-- Special case when the last text fragment still has a "'s".
+-- Should we allow this?
+--
+-- >>> toObjectPath [LS.MTT "x's", LS.MTT "z's"]
+-- Just ("x",["z's"])
+--
+-- >>> toObjectPath [LS.MTT "x's", LS.MTT "y's", LS.MTT "z"]
+-- Just ("x",["y","z"])
+--
+-- >>> toObjectPath [LS.MTT "f", LS.MTT "x", LS.MTT "y"]
+-- Nothing
+--
+-- >>> toObjectPath []
+-- Nothing
+toObjectPath :: LS.MultiTerm -> Maybe (Text, [Text])
+toObjectPath [] = Nothing
+toObjectPath (varNameInGenitive : attrs) = do
+  varName <- LS.isMtexprText varNameInGenitive >>= isGenitive
+  textAttrsInGenitive <- traverse LS.isMtexprText attrs
+  textAttrs <- applyToInit isGenitive textAttrsInGenitive
+  pure (varName, textAttrs)
+ where
+  applyToInit :: (a -> Maybe a) -> [a] -> Maybe [a]
+  applyToInit _ [] = Just []
+  applyToInit _ [x] = Just [x]
+  applyToInit f (x : xs) = (:) <$> f x <*> applyToInit f xs
+
+-- | Is a text message in genitive form?
+isGenitive :: Text -> Maybe Text
+isGenitive = Text.stripSuffix genitiveSuffix
+
+genitiveSuffix :: Text
+genitiveSuffix = Text.pack "'s"
+
+-- ----------------------------------------------------------------------------
+-- Example data for debugging.
+-- TODO: don't merge this
+-- ----------------------------------------------------------------------------
+
+type Err = Either String
+type ParseFun a = [Parser.Token] -> Err a
+type Verbosity = Int
+
+run :: String -> Either String Rule
+run = fmap Parser.transRule . Parser.pRule . Parser.myLexer
+
+runList :: String -> Either String [Rule]
+runList = fmap (fmap Parser.transRule) . Parser.pListRule . Parser.myLexer
diff --git a/lib/haskell/natural4/src/LS/Types.hs b/lib/haskell/natural4/src/LS/Types.hs
index 9fdd210b0..0ba23b716 100644
--- a/lib/haskell/natural4/src/LS/Types.hs
+++ b/lib/haskell/natural4/src/LS/Types.hs
@@ -57,6 +57,16 @@ data MTExpr = MTT Text.Text -- ^ Text string
 --            | MTD Text.Text -- ^ Date
             deriving (Eq, Ord, Show, Generic, Hashable, ToJSON)
 
+-- GIVEN x
+-- DECIDE f x IS y
+-- WHERE  y's book's color IS 'green
+
+-- let f = fun(x) => { book = { color = 'green } }
+
+-- [ MTT x's, MTT book's, MTT color ]
+-- [ RnVariable x, RnSelector book, RnSelector color]
+-- [ x.book.color ]
+
 makePrisms ''MTExpr
 
 type PlainParser = ReaderT RunConfig (Parsec Void MyStream)
@@ -120,8 +130,8 @@ type MultiTerm = [MTExpr] --- | apple | banana | 100 | $100 | 1 Feb 1970
 --
 -- > action = ( "walk" :| [] , Nothing )
 --
--- | notify | the government |    |         |
--- |        | immediately    | :: | Urgency |
+-- >| notify | the government |    |         |
+-- >|        | immediately    | :: | Urgency |
 type ParamText = NonEmpty TypedMulti
 
 text2pt :: Text.Text -> ParamText
@@ -134,6 +144,10 @@ mtexpr2text (MTF n) = [i|#{n}|]
 mtexpr2text (MTB True) = "TRUE"
 mtexpr2text (MTB False) = "FALSE"
 
+isMtexprText :: MTExpr -> Maybe Text.Text
+isMtexprText (MTT t) = Just t
+isMtexprText _ = Nothing
+
 pt2text :: ParamText -> Text.Text
 pt2text = Text.unwords . fmap mtexpr2text . toList . (fst =<<)
 
@@ -523,10 +537,10 @@ type ClassHierarchyMap = Map.HashMap EntityType TypedClass
 
 -- | ScopeTabs: In the course of a program we will sometimes see ad-hoc variables used in GIVEN and elsewhere.
 -- those end up in the ScopeTabs object returned by the `symbolTable` function.
-
+--
 -- We also see explicit variable definitions given by (DEFINE ... HAS ...). These also end up in ScopeTabs.
 -- If such a definition appears under a WHERE limb of another rule, it is scoped to that rule.
-
+--
 -- If it is given at top level, then it is under ... global scope, which is represented by Rulename=[]
 -- The keys to ScopeTabs are from ruleLabelName.
 
@@ -535,9 +549,9 @@ type ScopeTabs = Map.HashMap RuleName SymTab
 --  | SymTabs are a helper data structure used by ScopeTabs.
 -- the fst contains type-related information.
 -- the snd contains value-related information.
-
+--
 -- this type is getting pretty hefty, soon it'll be time to give it a proper type definition.
-
+--
 type SymTab = Map.HashMap MultiTerm (Inferrable TypeSig, [HornClause2])
 
 -- | The explicitly annotated types from the L4 source text are recorded in the fst of Inferrable.
diff --git a/lib/haskell/natural4/src/LS/XPile/Common.hs b/lib/haskell/natural4/src/LS/XPile/Common.hs
new file mode 100644
index 000000000..d29bd44e6
--- /dev/null
+++ b/lib/haskell/natural4/src/LS/XPile/Common.hs
@@ -0,0 +1,39 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE LambdaCase #-}
+
+module LS.XPile.Common where
+
+import Data.Hashable (Hashable)
+import Data.Text qualified as T
+import GHC.Generics (Generic)
+import LS.Types (ParamType (..), TypeSig (..), enumLabels)
+
+-- Functions and utilities that are not specific to individual transpilers.
+
+-- ----------------------------------------------------------------------------
+-- L4 declared entity types
+-- ----------------------------------------------------------------------------
+
+-- | GML types that are declared in L4 by the user, e.g. 'Person' or 'Singaporean citizen'.
+data L4EntityType
+  = -- | a user-defined named type
+    L4EntityType T.Text
+  | -- | a user-defined enumeration type
+    L4Enum [T.Text]
+  | -- | a user-defined list type
+    L4List L4EntityType
+  deriving stock (Eq, Generic, Show, Ord)
+  deriving anyclass (Hashable)
+
+{- | Turn a surface-L4 type signature into a GML type.
+
+NOTE / TODO: This translation seems lossy.
+-}
+mkEntityType :: TypeSig -> L4EntityType
+mkEntityType = \case
+  SimpleType TOne tn -> L4EntityType tn
+  SimpleType TOptional tn -> L4EntityType tn -- no optional
+  SimpleType _ tn -> L4List $ mkEntityType $ SimpleType TOne tn -- lists, sets, no difference
+  InlineEnum _ pt -> L4Enum $ enumLabels pt -- assuming no lists here (is there an example of a list of enum values?)
+
diff --git a/lib/haskell/natural4/src/LS/XPile/MathLang/GenericMathLang/GenericMathLangAST.hs b/lib/haskell/natural4/src/LS/XPile/MathLang/GenericMathLang/GenericMathLangAST.hs
index 85aceda48..350bb514c 100644
--- a/lib/haskell/natural4/src/LS/XPile/MathLang/GenericMathLang/GenericMathLangAST.hs
+++ b/lib/haskell/natural4/src/LS/XPile/MathLang/GenericMathLang/GenericMathLangAST.hs
@@ -27,42 +27,12 @@ import Data.Time (Day(..))
 import Optics (re, view)
 import Optics.TH (makeFieldLabelsNoPrefix, makePrisms)
 import GHC.Generics
--- import Data.List.NonEmpty (NonEmpty(..))
--- import Data.List.NonEmpty qualified as NE
-
--- import Data.Generics.Product.Types (types)
--- import Data.String ( IsString )
--- import Data.String.Interpolate (i)
-
-import LS.Types (TypeSig(..), ParamType(..), enumLabels)
 
 import Data.HashMap.Strict (HashMap, empty)
 import Data.Hashable (Hashable)
 import Data.Coerce (coerce)
 import Language.Haskell.TH.Syntax (Lift)
--- import GHC.Generics (Generic)
-
------------- L4 declared entity types ----------------------
-
--- | GML types that are declared in L4 by the user, e.g. 'Person' or 'Singaporean citizen'.
---
-data L4EntityType =
-    L4EntityType T.Text  -- ^ a user-defined named type
-  | L4Enum [T.Text]   -- ^ a user-defined enumeration type
-  | L4List L4EntityType  -- ^ a user-defined list type
-  deriving stock (Eq, Generic, Show, Ord)
-  deriving anyclass (Hashable)
-
--- | Turn a surface-L4 type signature into a GML type.
---
--- NOTE / TODO: This translation seems lossy.
---
-mkEntType :: TypeSig -> L4EntityType
-mkEntType = \case
-  SimpleType TOne      tn -> L4EntityType tn
-  SimpleType TOptional tn -> L4EntityType tn -- no optional
-  SimpleType _         tn -> L4List $ mkEntType $ SimpleType TOne tn -- lists, sets, no difference
-  InlineEnum _         pt -> L4Enum $ enumLabels pt -- assuming no lists here (is there an example of a list of enum values?)
+import LS.XPile.Common
 
 {-------------------------------------------------------
     AST
diff --git a/lib/haskell/natural4/src/LS/XPile/MathLang/GenericMathLang/ToGenericMathLang.hs b/lib/haskell/natural4/src/LS/XPile/MathLang/GenericMathLang/ToGenericMathLang.hs
index 7b863d492..d8a0a3775 100644
--- a/lib/haskell/natural4/src/LS/XPile/MathLang/GenericMathLang/ToGenericMathLang.hs
+++ b/lib/haskell/natural4/src/LS/XPile/MathLang/GenericMathLang/ToGenericMathLang.hs
@@ -26,7 +26,7 @@ how much would be needed to in effect parse the notoriously complicated L4 data
 {-# LANGUAGE BlockArguments #-}
 
 module LS.XPile.MathLang.GenericMathLang.ToGenericMathLang
-  (toMathLangGen, getHornlikes, insertTypeDecls, expandHornlikes)
+  (toMathLangGen, getHornlikes, insertTypeDecls, expandHornlikes, toMathLangGen')
 where
 
 import AnyAll (BoolStructF (..))
@@ -80,6 +80,15 @@ toMathLangGen l4i =
     Left errors -> makeErrorOut errors
     Right lamCalcProgram -> (renderLC lamCalcProgram, [])
 
+toMathLangGen' :: Interpreted -> LCProgram
+toMathLangGen' l4i =
+  let l4Hornlikes = getHornlikes l4i
+--                      |> expandHornlikes l4i
+                      |> insertTypeDecls l4i
+  in case runToLC $ l4ToLCProgram l4Hornlikes of
+    Left errors -> error $ show errors
+    Right lamCalcProgram -> lamCalcProgram
+
 -- Utility functions for expanding rules and inserting TypeDecls into GIVENs
 -- (Introduced in 2024-06, I hope we deal with global vs. local variables better later.)
 
diff --git a/lib/haskell/natural4/src/LS/XPile/MathLang/GenericMathLang/TranslateL4.hs b/lib/haskell/natural4/src/LS/XPile/MathLang/GenericMathLang/TranslateL4.hs
index 31df140d2..abe69d994 100644
--- a/lib/haskell/natural4/src/LS/XPile/MathLang/GenericMathLang/TranslateL4.hs
+++ b/lib/haskell/natural4/src/LS/XPile/MathLang/GenericMathLang/TranslateL4.hs
@@ -65,10 +65,13 @@ import LS.Rule (
                 getGiven,
                 RuleLabel)
 import LS.Rule qualified as L4 (Rule(..))
+import LS.Utils ((|$>))
+import LS.XPile.Common
 
 import Effectful (Eff, (:>), runPureEff)
 import Effectful.Error.Static (Error, runErrorNoCallStack, throwError)
 import Effectful.Reader.Static (Reader, runReader, local, asks, ask)
+import Effectful.State.Dynamic qualified as State
 import Data.HashMap.Strict qualified as HM
 import Data.Hashable (Hashable)
 import Flow ((|>))
@@ -78,7 +81,7 @@ import Data.List.NonEmpty qualified as NE
 import Data.String.Interpolate (i)
 import Data.Text qualified as T
 import Data.Foldable qualified as F (toList, foldrM)
-import LS.Utils ((|$>))
+import Data.Bifunctor (bimap)
 
 -- for parsing expressions that are just strings inside MTExpr
 import Control.Monad.Combinators.Expr (makeExprParser, Operator(..))
@@ -92,7 +95,7 @@ import Text.Regex.PCRE.Heavy qualified as PCRE
 import Text.Read (readMaybe)
 import Prelude hiding (exp)
 import Debug.Trace (trace)
-import Effectful.State.Dynamic qualified as State
+
 
 -- $setup
 -- >>> import Data.Text qualified as T
@@ -291,8 +294,8 @@ throwErrorImpossibleWithMsg = throwErrorBase ErrImpossible
 
 type VarTypeDeclMap = HM.HashMap Var (Maybe L4EntityType)
 type ReturnVarInfo = [(Var, Maybe L4EntityType)]
-data UserDefinedFun = MkUserFun {
-    getFunName :: Var
+data UserDefinedFun = MkUserFun
+  { getFunName :: Var
   , getFunDef :: Exp
   , getBoundVars :: [Var]
   , getOperMP :: Operator Parser BaseExp
@@ -394,7 +397,10 @@ runParserInLCContext act = do
 -- Expects a list of Hornlike rules, produces a translated GML program
 -- in the form of an 'LCProgram'.
 --
-l4ToLCProgram :: (Error ToLCError :> es, Reader Env :> es, State.State [UserDefinedFun] :> es) => [L4.Rule] -> Eff es LCProgram
+l4ToLCProgram ::
+  (Error ToLCError :> es, Reader Env :> es, State.State [UserDefinedFun] :> es) =>
+  [L4.Rule] ->
+  Eff es LCProgram
 l4ToLCProgram rules = do
   l4HLs <- traverse simplifyL4Hlike rules
   let customUserFuns = iterateFuns [] $ F.toList l4HLs
@@ -474,7 +480,7 @@ mkL4VarTypeDeclAssocList = convertL4Types . declaredVarsToAssocList
     declaredVarsToAssocList dvars = dvars ^.. folded % to getGiven % folded
 
     convertL4Types :: [(T.Text, Maybe TypeSig)] -> [(Var, Maybe L4EntityType)]
-    convertL4Types = each % _1 %~ mkVar >>> each % _2 %~ fmap mkEntType
+    convertL4Types = fmap (bimap mkVar (fmap mkEntityType))
 
 mkVarEntityMap :: Foldable f => f TypedMulti -> VarTypeDeclMap
 mkVarEntityMap = HM.fromList . mkL4VarTypeDeclAssocList
diff --git a/lib/haskell/natural4/src/LS/XPile/MathLang/MathLang.hs b/lib/haskell/natural4/src/LS/XPile/MathLang/MathLang.hs
index 5e118178c..bc729fb83 100644
--- a/lib/haskell/natural4/src/LS/XPile/MathLang/MathLang.hs
+++ b/lib/haskell/natural4/src/LS/XPile/MathLang/MathLang.hs
@@ -39,6 +39,7 @@ import Flow ((|>))
 
 import LS.Rule (Interpreted (..))
 import LS.XPile.IntroReader (MyEnv)
+import LS.XPile.Common qualified as Common
 import LS.XPile.MathLang.GenericMathLang.GenericMathLangAST (BaseExp (..), ExplnAnnot (l4RuleName))
 import LS.XPile.MathLang.GenericMathLang.GenericMathLangAST qualified as GML
 import LS.XPile.MathLang.GenericMathLang.TranslateL4 qualified as GML
@@ -281,7 +282,7 @@ gml2ml exp = case expExp of
 
     getList :: GML.Exp -> Maybe [GML.Exp]
     getList gmlExp = case (gmlExp.exp, GML.typeLabel <$> gmlExp.md) of
-      (ESeq seqExp, Just (GML.FromUser (GML.L4List _)):_)
+      (ESeq seqExp, Just (GML.FromUser (Common.L4List _)):_)
         -> Just (GML.seqExpToExprs seqExp)
       _ -> Nothing
 
diff --git a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
index 2b9f98739..c9bac01ac 100644
--- a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
+++ b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
@@ -1,4 +1,891 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# OPTIONS_GHC -Wall #-}
+
 module LS.XPile.Simala.Transpile where
 
+import Control.Monad.Error.Class (MonadError (..))
+import Control.Monad.Trans.Except
+import Data.Foldable qualified as Foldable
+import Data.Function (on)
+import Data.List.NonEmpty (NonEmpty ((:|)))
+import Data.List.NonEmpty qualified as NE
+import Data.String.Interpolate
+import Data.Text (Text)
+import Data.Text qualified as Text
+import Data.Text.IO qualified as Text
+import Data.Text.Lazy.IO qualified as TL
+import Debug.Trace
+import Optics
+import Text.Pretty.Simple qualified as Pretty
+
+import LS.Renamer
+import LS.Renamer qualified as Renamer
+import LS.Types qualified as LS
+
+import AnyAll.BoolStruct qualified as AA
+import Simala.Expr.Render qualified as Simala
+import Simala.Expr.Type qualified as Simala
+
+-- | A @'SimalaTerm'@ is like a 'Simala.Expr' but in an unsaturated form.
+-- By "unsaturated", we mean that there might be holes in the expression that
+-- we need to fill in later during further translation.
+--
+-- Thus, we pull out some of the 'Simala.Expr' constructors that we intend
+-- process further.
+-- Anything wrapped in 'TermExpr' is supposed to be opaque to the transpiler.
+data SimalaTerm
+  = -- | The head of a simala function.
+    -- For example @f(x, y)@, where @f@ is a function and @x,y@ are its parameters.
+    --
+    -- This is primarily used to translate a function head when we don't
+    -- know yet how to translate the body expression of the function.
+    TermApp Simala.Name [Simala.Name]
+  | -- | Assign the given name with some expression.
+    -- May contain intermediate selectors.
+    --
+    -- @x's y's z IS 5@
+    --
+    -- is translates to
+    --
+    -- @x = { y = { z = 5 }}@
+    --
+    -- However, if no intermediate selectors are present, this is a simple assignment:
+    --
+    -- @x IS 4@
+    --
+    -- is translated to
+    --
+    -- @x = 4@
+    TermAttribute Simala.Name [Simala.Name] Simala.Expr
+  | -- | A full fledged function definition. For example:
+    --
+    -- @f = fun(x, y) => x+y@
+    --
+    -- This aims to make the head of a function rule transparent for the transpiler.
+    -- Especially important, when a function has a boolean constraint that we need to
+    -- weave into the function definition.
+    --
+    -- Example:
+    --
+    -- @
+    -- DECIDE f x IS x IF x > 0;
+    --        f x IS 0 OTHERWISE
+    -- @
+    --
+    -- Is supposed to be translated to:
+    --
+    -- @
+    -- f = fun(x) => if x > 0 then x else 0
+    -- @
+    --
+    -- Note, in practice, we might not remove 'OTHERWISE' and define a constant for it.
+    TermFunction Simala.Name [Simala.Name] Simala.Expr
+  | -- | A Let-In construct without an 'in' part.
+    -- This is supposed to be used in simple variable assignment.
+    TermLetIn Simala.Transparency Simala.Name Simala.Expr
+  | -- | A simala expression that is supposed to be opaquely handled
+    -- as it is a fully transpiled expression with no kind of hole.
+    TermExpr Simala.Expr
+  deriving (Show)
+
+-- ----------------------------------------------------------------------------
+-- Top Level transpilation functions and test helpers
+-- ----------------------------------------------------------------------------
+
+transpileRule :: String -> IO ()
+transpileRule ruleSrc = do
+  rule <- case Renamer.run ruleSrc of
+    Left err -> do
+      putStrLn err
+      error ""
+    Right r -> pure r
+  TL.putStrLn $ Pretty.pShow rule
+  let
+    (res, s) = renameRuleTopLevel' rule
+  TL.putStrLn $ Pretty.pShow s
+  case res of
+    Left err -> putStrLn err
+    Right rnRule -> do
+      TL.putStrLn $ Pretty.pShow rnRule
+      simalaTerms <- runExceptT $ ruleToSimala rnRule
+      case simalaTerms of
+        Left err -> putStrLn err
+        Right expr -> do
+          Text.putStrLn $ "Expr: " <> render expr
+
+transpileRulePure :: String -> Text
+transpileRulePure ruleSrc =
+  let
+    Right rule = Renamer.run ruleSrc
+    (res, _s) = renameRuleTopLevel' rule
+  in
+    case res of
+      Left err -> Text.pack err
+      Right rnRule -> do
+        case runExcept $ ruleToSimala rnRule of
+          Left err -> Text.pack err
+          Right expr ->
+            render expr
+
+
+render :: SimalaTerm -> Text
+render (TermExpr e) = Simala.render e
+render (TermLetIn _ name var) = "let " <> Simala.render name <> " = " <> Simala.render var
+render (TermApp name params) = Simala.render name <> "(" <> Text.intercalate ", " (fmap Simala.render params) <> ")"
+render (TermFunction name params expr) = "let " <> Simala.render name <> " = fun(" <> Text.intercalate ", " (fmap Simala.render params) <> ") => " <> Simala.render expr
+render (TermAttribute name [] expr) = "let " <> Simala.render name <> " = " <> Simala.render expr
+render (TermAttribute name (x : xs) expr) = "let " <> Simala.render name <> " = " <> Simala.render (buildRecordUpdate (x :| xs) expr)
+
+-- ----------------------------------------------------------------------------
+-- Post Processing of rule transpilation
+-- These steps include:
+-- 1.
+-- ----------------------------------------------------------------------------
+
+ruleToSimala :: (MonadError String m) => RnRule -> m SimalaTerm
+ruleToSimala (Hornlike hornlike) = do
+  terms <- hornClausesToSimala hornlike.clauses
+  term <- assertSingletonList "ruleToSimala" terms
+  subTerms <- traverse ruleToSimala hornlike.wwhere
+  foldInSubTerms term subTerms
+
+hornClausesToSimala :: (MonadError String m) => [RnHornClause] -> m [SimalaTerm]
+hornClausesToSimala clauses = do
+  simalaTerms <- traverse processClause clauses
+  let
+    groupedSimalaTerms = groupClauses simalaTerms
+  simplifiedSimalaTerms <- mergeGroups groupedSimalaTerms
+  pure simplifiedSimalaTerms
+ where
+  processClause clause = do
+    hornHead <- relationalPredicateToSimala clause.rnHcHead
+    hornBody <- traverse boolStructToSimala clause.rnHcBody
+    pure (hornHead, hornBody)
+
+  groupClauses simalaTerms = do
+    NE.groupBy (compareClauseHeads `on` fst) simalaTerms
+
+-- ----------------------------------------------------------------------------
+-- Post Processing of rule translation.
+-- These steps include:
+-- 1.
+-- ----------------------------------------------------------------------------
+
+foldInSubTerms :: forall m. (MonadError String m) => SimalaTerm -> [SimalaTerm] -> m SimalaTerm
+foldInSubTerms top [] = pure top
+foldInSubTerms top (x : xs) = case top of
+  TermApp{} -> throwError $ "foldInSubTerms: Unexpected SimalaTerm: " <> show top
+  TermLetIn t name expr -> do
+    exprWithLocals <- linearLetIns expr (x :| xs)
+    pure $ TermLetIn t name exprWithLocals
+  TermExpr{} -> throwError $ "foldInSubTerms: Unexpected SimalaTerm: " <> show top
+  TermAttribute name selectors expr -> do
+    exprWithLocals <- linearLetIns expr (x :| xs)
+    pure $ TermAttribute name selectors exprWithLocals
+  TermFunction fnName fnParams fnExpr -> do
+    fnExprWithLocals <- linearLetIns fnExpr (x :| xs)
+    pure $ TermFunction fnName fnParams fnExprWithLocals
+ where
+  linearLetIns :: Simala.Expr -> NonEmpty SimalaTerm -> m Simala.Expr
+  linearLetIns finalExpr (x :| xs) = do
+    inExpr <- case xs of
+      [] -> pure finalExpr
+      (a : as) -> linearLetIns finalExpr (a :| as)
+    case x of
+      TermApp{} -> throwError $ "linearLetIns: Unexpected SimalaTerm: " <> show top
+      TermLetIn t name expr -> do
+        pure $ mkLetIn t name expr inExpr
+      TermExpr{} -> throwError $ "linearLetIns: Unexpected SimalaTerm: " <> show top
+      TermAttribute name [] expr -> do
+        pure $ mkLetIn Simala.Transparent name expr inExpr
+      TermAttribute name (a : as) expr -> do
+        pure $ mkLetIn Simala.Transparent name (buildRecordUpdate (a :| as) expr) inExpr
+      TermFunction fnName fnParams fnExpr -> do
+        pure $ mkLetIn Simala.Transparent fnName (Simala.Fun Simala.Transparent fnParams fnExpr) inExpr
+
+mergeGroups :: (Traversable t, MonadError String m) => t (NonEmpty (SimalaTerm, Maybe Simala.Expr)) -> m (t SimalaTerm)
+mergeGroups simalaTermGroups = do
+  traverse mergeGroups' simalaTermGroups
+
+mergeGroups' :: (MonadError String m) => NonEmpty (SimalaTerm, Maybe Simala.Expr) -> m SimalaTerm
+mergeGroups' ((TermAttribute name [] expr, _) :| _) = pure $ TermLetIn Simala.Transparent name expr
+mergeGroups' terms@((TermAttribute name _ _, _) :| _) = do
+  rowUpdates <- traverse assertNonEmptyTermAttribute $ fmap fst $ NE.toList terms
+  rowExprs <- traverse (pure . uncurry buildRecordUpdate) rowUpdates
+  recordRows <- traverse assertIsRecord rowExprs
+  treeRows <- mergeRecordUpdates recordRows
+  pure $ TermLetIn Simala.Transparent name treeRows
+mergeGroups' ((term, Nothing) :| _) =
+  pure term
+mergeGroups' ((term, Just g) :| []) = do
+  ifThenElseTerm <- mkIfThenElse g term (TermExpr Simala.Undefined)
+  pure ifThenElseTerm
+mergeGroups' ((term, Just g) :| (n : ns)) = do
+  elseBranch <- mergeGroups' (n :| ns)
+  mkIfThenElse g term elseBranch
+
+compareClauseHeads :: SimalaTerm -> SimalaTerm -> Bool
+compareClauseHeads (TermLetIn _ name1 _) (TermLetIn _ name2 _) = name1 == name2
+compareClauseHeads (TermFunction fnName1 _ _) (TermFunction fnName2 _ _) = fnName1 == fnName2
+compareClauseHeads (TermAttribute name1 _ _) (TermAttribute name2 _ _) = name1 == name2
+compareClauseHeads _ _ = False
+
+-- ----------------------------------------------------------------------------
+-- Transpilation
+-- ----------------------------------------------------------------------------
+
+relationalPredicateToSimala :: (MonadError String m) => RnRelationalPredicate -> m SimalaTerm
+relationalPredicateToSimala = \case
+  RnRelationalTerm lhs -> lhsMultiTermToSimala lhs
+  RnConstraint lhs LS.RPis rhs -> case lhs of
+    (mtHead : args)
+      | Just (fnName, fnParams) <- isFunctionDeclaration mtHead args -> do
+          rhsExpr <- rhsMultiTermToSimala rhs
+          mkFunction (toSimalaName fnName) (fmap toSimalaName fnParams) (TermExpr rhsExpr)
+      | Just (var, selectors) <- isAssignment mtHead args -> do
+          rhsExpr <- rhsMultiTermToSimala rhs
+          mkAssignment (toSimalaName var) (fmap toSimalaName selectors) rhsExpr
+      | otherwise -> throwError $ "relationalPredicateToSimala: Unsupported " <> show lhs
+    [] -> throwError "empty lhs"
+  RnConstraint lhs predicate rhs -> do
+    lhsSimalaExpr' <- lhsMultiTermToSimala lhs
+    lhsSimalaExpr <- assertTermExpr lhsSimalaExpr'
+    rhsSimalaExpr <- rhsMultiTermToSimala rhs
+    builtin <- fst <$> predRelToBuiltIn predicate
+    fixedArity builtin 2 [lhsSimalaExpr, rhsSimalaExpr]
+  RnNary LS.RPis (lhs : rhs) -> do
+    multiTerm <- assertPredicateIsMultiTerm "relationalPredicateToSimala" lhs
+    lhsSimalaTerm <- lhsMultiTermToSimala multiTerm
+    rhsExprs <- traverse relationalPredicateToSimala rhs
+    case lhsSimalaTerm of
+      TermApp fnName fnParams -> do
+        fnExpr <- assertSingletonList "RnNary.TermApp" rhsExprs
+        rhsExpr <- assertTermExpr fnExpr
+        mkFunction fnName fnParams (TermExpr rhsExpr)
+      TermLetIn{} -> throwError "Not implemented yet"
+      TermAttribute name selectors Simala.Undefined -> do
+        someRhs <- assertSingletonList "RnNary.TermAttribute" rhsExprs
+        rhsExpr <- assertTermExpr someRhs
+        pure $ TermAttribute name selectors rhsExpr
+      TermAttribute _name _selectors _expr -> throwError "Not implemented yet"
+      TermFunction{} -> throwError "Not implemented yet"
+      TermExpr expr -> throwError $ "A saturated expression can't be left hand side: " <> show expr
+  -- TODO: this is wrong, what about Var and Project?
+  RnNary relationalPredicate mt ->
+    predicateToSimala relationalPredicate mt
+  RnBoolStructR lhsExpr relationalPredicate bs -> do
+    lhsMultiTermToSimala lhsExpr
+  p -> throwError $ "Unhandled relational predicate: " <> show p
+
+predicateToSimala :: (MonadError String m) => LS.RPRel -> [RnRelationalPredicate] -> m SimalaTerm
+predicateToSimala rp params' = do
+  params <- traverse relationalPredicateToSimala params'
+  exprs <- traverse assertTermExpr params
+  (_, builder) <- predRelToBuiltIn rp
+  builder exprs
+
+predRelToBuiltIn :: (MonadError String m) => LS.RPRel -> m (Simala.Builtin, [Simala.Expr] -> m SimalaTerm)
+predRelToBuiltIn rp = case rp of
+  LS.RPis -> throwError $ "Unsupported relational predicate: " <> show rp
+  LS.RPhas -> throwError $ "Unsupported relational predicate: " <> show rp
+  LS.RPeq -> pure (Simala.Eq, fixedArity Simala.Eq 2)
+  LS.RPlt -> pure (Simala.Lt, fixedArity Simala.Lt 2)
+  LS.RPlte -> pure (Simala.Le, fixedArity Simala.Le 2)
+  LS.RPgt -> pure (Simala.Gt, fixedArity Simala.Gt 2)
+  LS.RPgte -> pure (Simala.Ge, fixedArity Simala.Ge 2)
+  LS.RPelem -> throwError $ "Unsupported relational predicate: " <> show rp
+  LS.RPnotElem -> throwError $ "Unsupported relational predicate: " <> show rp
+  LS.RPnot -> pure (Simala.Not, fixedArity Simala.Not 1)
+  LS.RPand -> pure (Simala.And, flexibleArity Simala.And)
+  LS.RPor -> pure (Simala.Or, flexibleArity Simala.Or)
+  LS.RPsum -> pure (Simala.Sum, flexibleArity Simala.Sum)
+  LS.RPproduct -> pure (Simala.Product, flexibleArity Simala.Product)
+  LS.RPminus -> pure (Simala.Minus, fixedArity Simala.Minus 2)
+  LS.RPdivide -> pure (Simala.Divide, fixedArity Simala.Divide 2)
+  LS.RPmodulo -> pure (Simala.Modulo, fixedArity Simala.Modulo 2)
+  LS.RPsubjectTo -> throwError $ "Unsupported relational predicate: " <> show rp
+  LS.RPmin -> pure (Simala.Maximum, atLeastArity Simala.Maximum 1)
+  LS.RPmax -> pure (Simala.Minimum, atLeastArity Simala.Minimum 1)
+  LS.RPmap -> throwError $ "Unsupported relational predicate: " <> show rp
+  LS.RPTC _temporal -> throwError $ "Unsupported relational predicate: " <> show rp
+
+flexibleArity :: (MonadError String m) => Simala.Builtin -> [Simala.Expr] -> m SimalaTerm
+flexibleArity b params = do
+  pure $ TermExpr $ Simala.Builtin b params
+
+atLeastArity :: (MonadError String m) => Simala.Builtin -> Int -> [Simala.Expr] -> m SimalaTerm
+atLeastArity b arity params' = do
+  params <- assertLengthAtLeast arity params'
+  pure $ TermExpr $ Simala.Builtin b params
+
+fixedArity :: (MonadError String m) => Simala.Builtin -> Int -> [Simala.Expr] -> m SimalaTerm
+fixedArity b arity params' = do
+  params <- assertLength arity params'
+  pure $ TermExpr $ Simala.Builtin b params
+
+lhsMultiTermToSimala :: (MonadError String m) => RnMultiTerm -> m SimalaTerm
+lhsMultiTermToSimala [rnExpr] = pure $ TermExpr $ exprToSimala rnExpr
+lhsMultiTermToSimala (mtHead : rest)
+  | Just (fnName, fnParams) <- isFunctionDeclaration mtHead rest =
+      mkFunctionHead (toSimalaName fnName) (fmap toSimalaName fnParams)
+  | Just (varName, selectors) <- isProjection mtHead rest =
+      mkRecordAssignment (toSimalaName varName) (fmap toSimalaName selectors)
+lhsMultiTermToSimala xs = throwError $ "lhsMultiTermToSimala: unsupported pattern: " <> show xs
+
+rhsMultiTermToSimala :: (MonadError String m) => RnMultiTerm -> m Simala.Expr
+rhsMultiTermToSimala [rnExpr] = pure $ exprToSimala rnExpr
+rhsMultiTermToSimala (mtHead : rest)
+  | Just _fnName <- isFunction mtHead = pure $ Simala.App (exprToSimala mtHead) $ fmap exprToSimala rest
+  | Just (varName, selectors) <- isProjection mtHead rest = pure $ applySelectors (toSimalaName varName) (fmap toSimalaName selectors)
+rhsMultiTermToSimala exprs = throwError $ "Unhandled rhs: " <> show exprs
+
+boolStructToSimala :: (MonadError String m) => RnBoolStructR -> m Simala.Expr
+boolStructToSimala = \case
+  AA.Leaf relationalPredicate -> do
+    simalaTerm <- relationalPredicateToSimala relationalPredicate
+    assertTermExpr simalaTerm
+  AA.Any _lbl structs -> do
+    simalaExprs <- traverse boolStructToSimala structs
+    simalaAny <- flexibleArity Simala.Or simalaExprs
+    assertTermExpr simalaAny
+  AA.All _lbl structs -> do
+    simalaExprs <- traverse boolStructToSimala structs
+    simalaAll <- flexibleArity Simala.And simalaExprs
+    assertTermExpr simalaAll
+  AA.Not struct -> do
+    simalaExpr <- boolStructToSimala struct
+    simalaNot <- fixedArity Simala.Not 1 [simalaExpr]
+    assertTermExpr simalaNot
+
+-- ----------------------------------------------------------------------------
+-- Rule pattern recognition
+-- ----------------------------------------------------------------------------
+
+isAssignment :: RnExpr -> [RnExpr] -> Maybe (RnName, [RnName])
+isAssignment name selectors = do
+  rnName <- isVariable name
+  rnSelectors <- traverse isSelector selectors
+  pure (rnName, rnSelectors)
+
+isFunctionDeclaration :: (Traversable t) => RnExpr -> t RnExpr -> Maybe (RnName, t RnName)
+isFunctionDeclaration mtHead args = do
+  fnName <- isFunction mtHead
+  argNames <- traverse isVariable args
+  pure (fnName, argNames)
+
+isProjection :: RnExpr -> [RnExpr] -> Maybe (RnName, NE.NonEmpty RnName)
+isProjection mtHead args = do
+  varName <- isVariable mtHead
+  nonEmptyRest <- NE.nonEmpty args
+  selectors <- traverse isSelector nonEmptyRest
+  pure (varName, selectors)
+
+-- ----------------------------------------------------------------------------
+-- Name translations
+-- ----------------------------------------------------------------------------
+
+exprToSimala :: RnExpr -> Simala.Expr
+exprToSimala (RnExprName name) = Simala.Var $ toSimalaName name
+exprToSimala (RnExprLit lit) = Simala.Lit $ litToSimala lit
+
+litToSimala :: RnLit -> Simala.Lit
+litToSimala = \case
+  RnInt int -> Simala.IntLit $ fromIntegral int -- TODO: why does simala only support 'Int'?
+  RnDouble _double -> error "Floating point numbers are unsupported in simala"
+  RnBool boolean -> Simala.BoolLit boolean
+
+isFunction :: RnExpr -> Maybe RnName
+isFunction expr = isExprOfType expr (RnFunction ==)
+
+isVariable :: RnExpr -> Maybe RnName
+isVariable expr = isExprOfType expr (RnVariable ==)
+
+isSelector :: RnExpr -> Maybe RnName
+isSelector expr = isExprOfType expr (RnSelector ==)
+
+isExprOfType :: RnExpr -> (RnNameType -> Bool) -> Maybe RnName
+isExprOfType (RnExprName name) hasTy
+  | hasTy name.rnNameType = Just name
+  | otherwise = Nothing
+isExprOfType (RnExprLit _) _ = Nothing
+
+-- ----------------------------------------------------------------------------
+-- Name translations
+-- ----------------------------------------------------------------------------
+
+toSimalaName :: RnName -> Simala.Name
+toSimalaName name =
+  Text.intercalate
+    "_"
+    [ rnNameTypePrefix name.rnNameType
+    , slugifiedOccName
+    , Text.pack (show name.rnUniqueId)
+    ]
+ where
+  slugifiedOccName =
+    name.rnOccName
+      & NE.toList
+      & fmap LS.mtexpr2text
+      & Text.intercalate "_"
+      & Text.replace " " "_"
+
+rnNameTypePrefix :: RnNameType -> Text
+rnNameTypePrefix = \case
+  RnSelector -> "s"
+  RnFunction -> "f"
+  RnVariable -> "v"
+  RnType -> "t"
+  RnEnum -> "e"
+  RnBuiltin -> "b"
+
+-- ----------------------------------------------------------------------------
+-- Assertion helpers
+-- ----------------------------------------------------------------------------
+
+assertSingletonList :: (MonadError String m) => String -> [a] -> m a
+assertSingletonList _errMsg [a] = pure a
+assertSingletonList errMsg as =
+  throwError $
+    errMsg
+      <> "\nExpected singleton list but got: "
+      <> show (length as)
+      <> " elements"
+
+assertLengthAtLeast :: (MonadError String m) => Int -> [a] -> m [a]
+assertLengthAtLeast l as =
+  let
+    len = length as
+  in
+    if len < l
+      then
+        throwError $
+          "Unexpected list size, expected at least: "
+            <> show l
+            <> " but got: "
+            <> show (length as)
+      else pure as
+
+assertLength :: (MonadError String m) => Int -> [a] -> m [a]
+assertLength l as =
+  let
+    len = length as
+  in
+    if len /= l
+      then
+        throwError $
+          "Expected list size, expected: "
+            <> show l
+            <> " but got: "
+            <> show (length as)
+      else pure as
+
+assertPredicateIsMultiTerm :: (MonadError String m) => String -> RnRelationalPredicate -> m RnMultiTerm
+assertPredicateIsMultiTerm _errMsg (RnRelationalTerm mt) = pure mt
+assertPredicateIsMultiTerm errMsg predicate = throwError $ errMsg <> "\nExpected RnRelationalTerm but got: " <> show predicate
+
+assertTermExpr :: (MonadError String m) => SimalaTerm -> m Simala.Expr
+assertTermExpr (TermExpr expr) = pure expr
+assertTermExpr term = throwError $ "Expected TermExpr but got: " <> show term
+
+assertEquals :: (MonadError String m, Eq a, Show a) => a -> a -> m ()
+assertEquals a b
+  | a == b = pure ()
+  | otherwise = throwError $ "Provided args are not equal: " <> show a <> " /= " <> show b
+
+assertIsRecord :: (MonadError String m) => Simala.Expr -> m (Simala.Row Simala.Expr)
+assertIsRecord (Simala.Record row) = pure row
+assertIsRecord simalaExpr = throwError $ "Unexpected simala expression, expected Record but got: " <> show simalaExpr
+
+assertNonEmptyTermAttribute :: (MonadError String m) => SimalaTerm -> m (NonEmpty Simala.Name, Simala.Expr)
+assertNonEmptyTermAttribute (TermAttribute _ (x : xs) expr) = pure (x :| xs, expr)
+assertNonEmptyTermAttribute expr@(TermAttribute _ [] _) = throwError $ "Unexpected term, expected non-empty TermAttribute but got : " <> show expr
+assertNonEmptyTermAttribute expr = throwError $ "Unexpected term, expected non-empty TermAttribute but got : " <> show expr
+
+-- ----------------------------------------------------------------------------
+-- Construction helpers for simala terms
+-- ----------------------------------------------------------------------------
+
+mkAssignment :: (MonadError String m) => Simala.Name -> [Simala.Name] -> Simala.Expr -> m SimalaTerm
+mkAssignment name selectors expr = pure $ TermAttribute name selectors expr
+
+mkFunctionHead :: (MonadError String m) => Simala.Name -> [Simala.Name] -> m SimalaTerm
+mkFunctionHead funcName funcParams = pure $ TermApp funcName funcParams
+
+mkRecordAssignment :: (MonadError String m) => Simala.Name -> NE.NonEmpty Simala.Name -> m SimalaTerm
+mkRecordAssignment varName selectors =
+  pure $
+    TermAttribute
+      varName
+      (NE.toList selectors)
+      Simala.Undefined
+
+mkTransparentLetIn :: (MonadError String m) => Simala.Name -> SimalaTerm -> m SimalaTerm
+mkTransparentLetIn var term = do
+  body <- assertTermExpr term
+  pure $ TermLetIn Simala.Transparent var body
+
+mkFunction :: (MonadError String m) => Simala.Name -> [Simala.Name] -> SimalaTerm -> m SimalaTerm
+mkFunction fnName fnParams term = do
+  body <- assertTermExpr term
+  pure $ TermFunction fnName fnParams body
+
+mkIfThenElse :: (MonadError String m) => Simala.Expr -> SimalaTerm -> SimalaTerm -> m SimalaTerm
+mkIfThenElse b (TermLetIn t1 name1 expr1) (TermLetIn t2 name2 expr2) = do
+  assertEquals t1 t2
+  assertEquals name1 name2
+  ifThenElseTerm <- fixedArity Simala.IfThenElse 3 [b, expr1, expr2]
+  ifThenElse <- assertTermExpr ifThenElseTerm
+  pure $ TermLetIn t1 name1 ifThenElse
+mkIfThenElse b (TermLetIn t1 name1 body1) (TermExpr expr) = do
+  ifThenElseTerm <- fixedArity Simala.IfThenElse 3 [b, body1, expr]
+  ifThenElse <- assertTermExpr ifThenElseTerm
+  pure $ TermLetIn t1 name1 ifThenElse
+mkIfThenElse b (TermAttribute name1 selectors1 expr1) (TermAttribute name2 selectors2 expr2) = do
+  assertEquals name1 name2
+  assertEquals selectors1 selectors2
+  ifThenElseTerm <- fixedArity Simala.IfThenElse 3 [b, expr1, expr2]
+  ifThenElse <- assertTermExpr ifThenElseTerm
+  pure $ TermAttribute name1 selectors1 ifThenElse
+mkIfThenElse b (TermFunction fnName1 fnParams1 expr1) (TermFunction fnName2 fnParams2 expr2) = do
+  assertEquals fnName1 fnName2
+  assertEquals fnParams1 fnParams2
+  ifThenElseTerm <- fixedArity Simala.IfThenElse 3 [b, expr1, expr2]
+  ifThenElse <- assertTermExpr ifThenElseTerm
+  pure $ TermFunction fnName1 fnParams1 ifThenElse
+mkIfThenElse b (TermFunction fnName1 fnParams1 expr1) (TermExpr expr) = do
+  ifThenElseTerm <- fixedArity Simala.IfThenElse 3 [b, expr1, expr]
+  ifThenElse <- assertTermExpr ifThenElseTerm
+  pure $ TermFunction fnName1 fnParams1 ifThenElse
+mkIfThenElse b (TermExpr expr1) (TermExpr expr2) = do
+  ifThenElseTerm <- fixedArity Simala.IfThenElse 3 [b, expr1, expr2]
+  ifThenElse <- assertTermExpr ifThenElseTerm
+  pure $ TermExpr ifThenElse
+mkIfThenElse _b term1 term2 =
+  throwError $
+    "Can't wrap terms in an if-then-else.\nFirst term: "
+      <> show term1
+      <> "\nSecond term: "
+      <> show term2
+
+-- ----------------------------------------------------------------------------
+-- Construction helpers for simala expressions
+-- ----------------------------------------------------------------------------
+
+applySelectors :: Simala.Name -> NonEmpty Simala.Name -> Simala.Expr
+applySelectors name selectors =
+  Foldable.foldl' applySelector (Simala.Var name) selectors
+
+-- | Apply a selector to the given expression.
+--
+-- TODO: this should only succeed if 'RnName.rnNameType == RnSelector'.
+applySelector :: Simala.Expr -> Simala.Name -> Simala.Expr
+applySelector expr proj = Simala.Project expr proj
+
+mkLetIn :: Simala.Transparency -> Simala.Name -> Simala.Expr -> Simala.Expr -> Simala.Expr
+mkLetIn transparency name rhs nextExpr =
+  Simala.Let transparency name rhs nextExpr
+
+buildRecordUpdate :: NonEmpty Simala.Name -> Simala.Expr -> Simala.Expr
+buildRecordUpdate names expr = go $ NE.toList names
+ where
+  go [] = expr
+  go (x : xs) = Simala.Record [(x, go xs)]
+
+-- TODO: what was I thinking?
+mergeRecordUpdates :: (MonadError String m) => [Simala.Row Simala.Expr] -> m Simala.Expr
+mergeRecordUpdates xs = worker xs
+ where
+  worker rows = do
+    let
+      vars = NE.groupAllWith fst $ concat rows
+    simpleRows <-
+      traverse
+        simplifyRow
+        vars
+    pure $ Simala.Record simpleRows
+
+  simplifyRow ::
+    (MonadError String m) =>
+    NonEmpty (Simala.Name, Simala.Expr) ->
+    m (Simala.Name, Simala.Expr)
+  simplifyRow ((n, expr) :| []) = pure (n, expr)
+  simplifyRow rows@((n, _) :| _) = do
+    let
+      rowExprs = fmap snd $ NE.toList rows
+    recordRows <- traverse assertIsRecord rowExprs
+    mergedRows <- worker recordRows
+    pure $ (n, mergedRows)
+
+-- [ (x, 4)]
+-- [ (y, 5)]
+-- [ (z, (a, (b, 5)))
+-- , (z, (b, 4))
+-- , (z, (a, (c, 5)))
+-- ]
+--
+--
+-- [ (z, [ (b, 4), (a, [(b, 5), (c, 5)]) ]) ]
+
+-- { x=4; y=5; z = { a = { b = 5; c = 5 }; b = 4 }
+
+-- ----------------------------------------------------------------------------
+-- Test cases
+-- ----------------------------------------------------------------------------
+
+-- >>> transpileRulePure exampleWithOneOf
+-- "let f_g_6 = fun(v_d_0) => let v_y_1 = s_green_3 in v_y_1"
+
+exampleWithOneOf :: String
+exampleWithOneOf =
+  [i|
+GIVEN d
+GIVETH y IS ONE OF green, red
+DECIDE g d IS y
+WHERE
+    y IS green IF d > 0;
+    y IS red OTHERWISE
+|]
+
+-- >>> transpileRulePure bookWithAttributes
+-- "relationalPredicateToSimala: Unsupported [RnExprName (RnName {rnOccName = MTT \"y's\" :| [], rnUniqueId = 4, rnNameType = RnFunction}),RnExprName (RnName {rnOccName = MTT \"book\" :| [], rnUniqueId = 2, rnNameType = RnSelector})]"
+
+bookWithAttributes :: String
+bookWithAttributes =
+  [i|
+GIVEN d
+DECIDE g d IS y
+WHERE
+    y's book IS green IF d > 0;
+    y's book IS red OTHERWISE
+|]
+
+-- >>> transpileRulePure idFunction
+-- "let f_id_1 = fun(v_x_0) => v_x_0"
+
+idFunction :: String
+idFunction =
+  [i|
+GIVEN x
+DECIDE id x IS x
+|]
+
+-- >>> transpileRulePure sumFunction
+-- "let f_sum3_1 = fun(v_x_0) => sum(v_x_0,v_x_0,v_x_0)"
+
+sumFunction :: String
+sumFunction =
+  [i|
+GIVEN x
+DECIDE sum3 x IS SUM(x, x, x)
+|]
+
+-- >>> transpileRulePure simpleSelector
+-- "let f_f_1 = fun(v_x_0) => v_x_0.s_z_2\n"
+
+simpleSelector :: String
+simpleSelector =
+  [i|
+GIVEN x
+DECIDE f x IS x's z
+|]
+
+-- >>> transpileRulePure nestedSelector
+-- "let f_f_1 = fun(v_x_0) => v_x_0.s_y_2.s_z_3"
+
+nestedSelector :: String
+nestedSelector =
+  [i|
+GIVEN x
+DECIDE f x IS x's y's z
+|]
+
+-- >>> transpileRulePure decideWithIfs
+-- "let f_f_1 = fun(v_x_0) => if v_x_0 > 0 then 1 else if b_OTHERWISE_2 then 0 else undefined"
+
+decideWithIfs :: String
+decideWithIfs =
+  [i|
+GIVEN x
+DECIDE f x IS 1 IF x > 0;
+       f x IS 0 OTHERWISE
+|]
+
+-- >>> transpileRulePure decideWithIfsNoOtherwise
+-- "let f_f_1 = fun(v_x_0) => if v_x_0 > 0 then 1 else 0"
+
+decideWithIfsNoOtherwise :: String
+decideWithIfsNoOtherwise =
+  [i|
+GIVEN x
+DECIDE f x IS 1 IF x > 0;
+       f x IS 0
+|]
+
+-- f = fun(x) => if y > 0 then 1 else 0
+-- let otherwise = true
+-- in
+--  let f = fun(x) => if y > 0 then 1 else 0
+
+-- >>> transpileRulePure decideWithIfs2
+-- "let f_f_1 = fun(v_x_0) => if v_x_0 > 0 then 1 else if b_OTHERWISE_2 then 0 else if v_x_0 < 0 then 2 else undefined"
+
+decideWithIfs2 :: String
+decideWithIfs2 =
+  [i|
+GIVEN x
+DECIDE f x IS 1 IF x > 0;
+       f x IS 0 OTHERWISE;
+       f x IS 2 IF x < 0
+|]
+
+-- >>> transpileRulePure decideWithAttributes
+-- "let f_f_4 = fun(v_x_0) => let v_y_1 = {s_p_3 = v_x_0 + v_x_0,s_z_2 = 0} in v_y_1"
+
+decideWithAttributes :: String
+decideWithAttributes =
+  [i|
+GIVEN x
+DECIDE f x IS y
+WHERE
+  y's z IS 0;
+  y's p IS SUM(x, x)
+|]
+
+-- >>> transpileRulePure decideWithConditionalAttributes
+-- "relationalPredicateToSimala: Unsupported [RnExprName (RnName {rnOccName = MTT \"y's\" :| [], rnUniqueId = 3, rnNameType = RnFunction}),RnExprName (RnName {rnOccName = MTT \"z\" :| [], rnUniqueId = 2, rnNameType = RnSelector})]"
+
+-- TODO: renamer bug, "y's" incorrectly
+
+decideWithConditionalAttributes :: String
+decideWithConditionalAttributes =
+  [i|
+GIVEN x
+DECIDE f x IS y
+WHERE
+  y's z IS 5 IF x > 5;
+  y's z IS 0 OTHERWISE;
+
+  y's p IS x IF x > 5;
+  y's p IS SUM(x, x) OTHERWISE
+|]
+
+-- let f = fun(x) =>
+--    let y_z = if x > 5 then 5 else 0 in
+--    let y_p = if x > 5 then x else sum(x, x) in
+--    let y = { z = y_s, p = y_p } in
+--    y
+
+-- >>> transpileRulePure givethDefinition
+-- "let v_y_0 = {s_z_1 = 5}\n"
+
+givethDefinition :: String
+givethDefinition =
+  [i|
+GIVETH y
+DECIDE y's z IS 5
+|]
+
+-- >>> transpileRulePure givethNestedDefinition
+-- "let v_y_0 = {s_a_1 = {s_b_2 = {s_c_3 = {s_z_4 = 5}}}}"
+
+givethNestedDefinition :: String
+givethNestedDefinition =
+  [i|
+GIVETH y
+DECIDE y's a's b's c's z IS 5
+|]
+
+-- >>> transpileRulePure eragonBookDescription
+-- "let v_eragon_0 = {s_character_4 = {s_friend_8 = s_Ork_9,s_main_5 = s_Eragon_2,s_villain_6 = s_Galbatorix_7},s_size_3 = 512,s_title_1 = s_Eragon_2}"
+
+-- TODO: Renamer bug: handle string literals
+
+eragonBookDescription :: String
+eragonBookDescription =
+  [i|
+GIVETH eragon
+DECIDE
+  eragon's title IS Eragon;
+  eragon's size IS 512;
+  eragon's character's main IS "Eragon";
+  eragon's character's villain IS "Galbatorix";
+  eragon's character's friend IS "Ork"
+|]
+
+-- >>> transpileRulePure eragonBookDescriptionWithWhere
+-- "let v_eragon_0 = let v_localVar_1 = {s_character_5 = {s_friend_9 = s_Ork_10,s_main_6 = s_Eragon_3,s_villain_7 = s_Galbatorix_8},s_size_4 = 512,s_title_2 = s_Eragon_3} in v_localVar_1"
+
+-- TODO: Renamer bug: handle string literals
+
+eragonBookDescriptionWithWhere :: String
+eragonBookDescriptionWithWhere =
+  [i|
+GIVETH eragon
+DECIDE
+  eragon IS localVar
+WHERE
+  localVar's title IS "Eragon";
+  localVar's size IS 512;
+  localVar's character's main IS "Eragon";
+  localVar's character's villain IS "Galbatorix";
+  localVar's character's friend IS "Ork"
+|]
+
+-- >>> transpileRulePure noGivethDefinitionShouldFail
+-- "let v_y_0 = {s_z_1 = 5}"
+--
+-- TODO: renamer fail, y is unknown, needs to fail!
+noGivethDefinitionShouldFail :: String
+noGivethDefinitionShouldFail =
+  [i|
+DECIDE y's z IS 5
+|]
+
+-- >>> transpileRulePure noGivethSimpleDefinitionShouldFail
+-- "let v_y_0 = 5"
+--
+-- TODO: renamer fail, y is unknown, needs to fail!
+noGivethSimpleDefinitionShouldFail :: String
+noGivethSimpleDefinitionShouldFail =
+  [i|
+DECIDE y IS 5
+|]
+
+-- >>> transpileRulePure rodentsAndVermin
+-- "relationalPredicateToSimala: Unsupported [RnExprName (RnName {rnOccName = MTT \"Loss or Damage\" :| [], rnUniqueId = 1, rnNameType = RnSelector})]"
+--
+rodentsAndVermin :: String
+rodentsAndVermin =
+  [i|
+§ "Rodents and vermin"
+DECIDE "Not Covered"
+IF
+   UNLESS ( "Loss or Damage" IS ANY ( "caused by rodents"
+                                    , "caused by insects"
+                                    , "caused by vermin"
+                                    , "caused by birds"
+                                    )
+
+          , ANY ( ALL ( "Loss or Damage" IS "to Contents"
+                      , "Loss or Damage" IS "caused by birds"
+                      )
+
+                , UNLESS ( "Loss or Damage" IS "ensuing covered loss"
+
+                         , ANY ( "any other exclusion applies"
+                               , "an animal caused water to escape from"
+                                    ANY ( "a household appliance"
+                                        , "a swimming pool"
+                                        , "a plumbing, heating, or air conditioning system" )
+                               )
+                         )
+                )
+        )
+|]
 
--- transpileToSimala :: Interpreter -> 
diff --git a/lib/haskell/natural4/src/LS/XPile/Simala/Types.hs b/lib/haskell/natural4/src/LS/XPile/Simala/Types.hs
index 4a09294a8..3bf60d362 100644
--- a/lib/haskell/natural4/src/LS/XPile/Simala/Types.hs
+++ b/lib/haskell/natural4/src/LS/XPile/Simala/Types.hs
@@ -1 +1,2 @@
 module LS.XPile.Simala.Types where
+
diff --git a/lib/haskell/natural4/test/LS/RenamerSpec.hs b/lib/haskell/natural4/test/LS/RenamerSpec.hs
new file mode 100644
index 000000000..a9fcf10c1
--- /dev/null
+++ b/lib/haskell/natural4/test/LS/RenamerSpec.hs
@@ -0,0 +1,77 @@
+
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+module LS.RenamerSpec(spec) where
+
+
+import LS.Rule
+import LS.Types
+import TextuaL4.Transform
+import TextuaL4.LexTextuaL   ( Token )
+import TextuaL4.ParTextuaL   ( pRule, pListRule, myLexer )
+import Text.Pretty.Simple ( pShowNoColor )
+import Text.RawString.QQ ( r )
+import Data.List ( intercalate )
+import Data.Text.Lazy qualified as TL
+import Data.Text.Lazy.IO qualified as TL
+import System.FilePath ( (<.>), (</>) )
+import Test.Hspec.Golden
+import Test.Hspec (Spec, describe, it, shouldBe)
+import Data.Either (fromRight)
+import qualified LS.Renamer as Renamer
+import qualified Control.Monad.Trans.State.Strict as State
+import Control.Monad.IO.Class
+import qualified Control.Monad.Trans.Except as Except
+
+
+goldenGeneric :: Show a => String -> a -> Golden TL.Text
+goldenGeneric name output_ = Golden
+  { output = pShowNoColor output_
+  , encodePretty = TL.unpack
+  , writeToFile = TL.writeFile
+  , readFromFile = TL.readFile
+  , goldenFile =  testPath <.> "expected"
+  , actualFile = Just (testPath <.> "actual")
+  , failFirstTime = False
+  }
+  where
+    testPath = "test" </> "testdata" </> "golden" </> name
+
+spec :: Spec
+spec = do
+  describe "Renamer" do
+    test' bookWithAttributes "Book Attributes" "decide-with-attributes"
+    test' idFunction "Id Function" "id-func"
+  where
+    test rule = test' rule rule
+
+    test' ruleSource desc fname = do
+      let rule :: Rule = fromRight RegBreach $ run ruleSource
+      let rnRule :: Either String Renamer.RnRule =
+            Except.runExcept (State.evalStateT (Renamer.renameRule rule) Renamer.emptyScope)
+      it desc $ goldenGeneric fname $ rnRule
+
+bookWithAttributes = [r|
+GIVEN d DECIDE g d IS y
+WHERE
+    y's book IS green IF d > 0;
+    y's book IS red OTHERWISE
+|]
+
+idFunction = [r|
+GIVEN x
+DECIDE id x IS x
+|]
+
+type Err        = Either String
+type ParseFun a = [Token] -> Err a
+type Verbosity  = Int
+
+run :: String -> Either String Rule
+run = fmap transRule . pRule . myLexer
+
+runList :: String -> Either String [Rule]
+runList = fmap (fmap transRule) . pListRule . myLexer
diff --git a/lib/haskell/natural4/test/PAUs.csv b/lib/haskell/natural4/test/PAUs.csv
index 501443918..be9f9ac23 100644
--- a/lib/haskell/natural4/test/PAUs.csv
+++ b/lib/haskell/natural4/test/PAUs.csv
@@ -130,8 +130,8 @@
 ,,,,,,,,,,,,,,,,,,
 ,,,GIVEN,x,,,IS A,Number,,,,,,,,,,
 ,,,,y,,,IS A,Number,,,,,,,,,,
-,,,DECIDE,x,discounted by,y,IS,x * (1 - y),,,,,,,,,,,
+,,,DECIDE,x,discounted by,y,IS,x * (1 - y),,,,,,,,,,
 ,,,,,,,,,,,,,,,,,,
 ,,,,,,,,,,,,,,,,,,
 ,,,DECIDE,lifetime claimable limit,,IS,"$4,500,000",,,,,,,,,,,
-,,,,juvenile limit,,IS,"$500,000",,,,,,,,,,,
\ No newline at end of file
+,,,,juvenile limit,,IS,"$500,000",,,,,,,,,,,
diff --git a/lib/haskell/natural4/test/testdata/golden/decide-with-attributes.expected b/lib/haskell/natural4/test/testdata/golden/decide-with-attributes.expected
new file mode 100644
index 000000000..9be9bcf84
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/decide-with-attributes.expected
@@ -0,0 +1 @@
+Nothing
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/id-func.expected b/lib/haskell/natural4/test/testdata/golden/id-func.expected
new file mode 100644
index 000000000..9be9bcf84
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/id-func.expected
@@ -0,0 +1 @@
+Nothing
\ No newline at end of file
diff --git a/lib/haskell/questions.md b/lib/haskell/questions.md
deleted file mode 100644
index 7e08f25c0..000000000
--- a/lib/haskell/questions.md
+++ /dev/null
@@ -1,15 +0,0 @@
-## Questions
-
-```haskell
-data SimpleHlike a b c =
-  MkSimpleHL { shClauseGiven :: a
-             , shClauseReturnVars :: b
-             , shBaseClauses :: BaseHL
-             , shRuleSrcRef :: SrcRef
-             -- ^ may want to parametrize this
-             , shRuleLabel :: c
-             }
-  deriving stock (Eq, Show, Generic)
-```
-
-What is `shClauseReturnVars`? The Giveth of the rule?
diff --git a/lib/haskell/stack.yaml b/lib/haskell/stack.yaml
index 67938ed35..3ab9707e5 100644
--- a/lib/haskell/stack.yaml
+++ b/lib/haskell/stack.yaml
@@ -13,6 +13,7 @@ packages:
 - natural4
 - anyall
 - explainable
+- ../../../simala
 
 extra-deps:
 # if you are actively developing both baby-l4 and the natural4 code that uses it (import L4.*)

From 7dc7fcbaf404a37977d521a271b8f3cf8d486736 Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Tue, 6 Aug 2024 09:14:24 +0200
Subject: [PATCH 03/44] Fix renamer of MultiTerms. Allow Strings and improve
 object path renaming

---
 lib/haskell/natural4/src/LS/Renamer.hs        | 96 +++++++++++++------
 .../natural4/src/LS/XPile/Simala/Transpile.hs | 75 ++++++++-------
 2 files changed, 110 insertions(+), 61 deletions(-)

diff --git a/lib/haskell/natural4/src/LS/Renamer.hs b/lib/haskell/natural4/src/LS/Renamer.hs
index 7fc12bbdc..27e2ea83e 100644
--- a/lib/haskell/natural4/src/LS/Renamer.hs
+++ b/lib/haskell/natural4/src/LS/Renamer.hs
@@ -19,7 +19,7 @@ import TextuaL4.ParTextuaL qualified as Parser
 import TextuaL4.Transform qualified as Parser
 
 import Control.Monad.Error.Class
-import Control.Monad.Extra (fromMaybeM)
+import Control.Monad.Extra (foldM, fromMaybeM)
 import Control.Monad.State.Class qualified as State
 import Control.Monad.State.Strict (MonadState)
 import Control.Monad.Trans.Except qualified as Except
@@ -119,6 +119,7 @@ data RnLit
   = RnInt Integer
   | RnDouble Double
   | RnBool Bool
+  | RnString Text
   deriving (Eq, Ord, Show, Generic)
 
 type RnMultiTerm = [RnExpr]
@@ -248,6 +249,28 @@ lookupFunction funcOccName =
   State.gets $ \s ->
     s ^. scScopeTable % stFunction % at funcOccName
 
+-- ----------------------------------------------------------------------------
+-- Helper types for local context
+-- ----------------------------------------------------------------------------
+
+-- | Intermediate context when renaming a '[MultiTerm]'.
+data MultiTermContext = MultiTermContext
+  { _multiTermContextInSelector :: Bool
+  -- ^ Did the previous 'MultiTerm' introduce a selector chain?
+  -- A selector chain is introduced, if the multi term has a genitive suffix.
+  -- For example: @[MTT "book's", MTT "title"]@, when @"title"@ is renamed,
+  -- the 'multiTermContextInSelector' is set expected to be to 'True', so that
+  -- we can infer that @"title"@ is a 'RnSelector'.
+  }
+
+makeFieldsNoPrefix 'MultiTermContext
+
+inSelectorContext :: MultiTermContext -> MultiTermContext
+inSelectorContext mtc = mtc & multiTermContextInSelector .~ True
+
+notInSelectorContext :: MultiTermContext -> MultiTermContext
+notInSelectorContext mtc = mtc & multiTermContextInSelector .~ False
+
 -- ----------------------------------------------------------------------------
 -- Top Level Definitions
 -- ----------------------------------------------------------------------------
@@ -468,7 +491,11 @@ renameDecideMultiTerm :: (MonadState Scope m, MonadError String m) => LS.MultiTe
 renameDecideMultiTerm mt = do
   scopeTable <- State.gets _scScopeTable
   case mt of
-    [] -> throwError "renameDecideMultiTerm: Unexpected empty list of MultiTerm"
+    attrs@(_ : _)
+      | Just (obj, objAttrs) <- toObjectPath attrs -> do
+          rnName <- lookupOrInsertName (mkSimpleOccName obj) RnVariable
+          rnObjAttrs <- mapM (\attr -> RnExprName <$> lookupOrInsertName (mkSimpleOccName attr) RnSelector) objAttrs
+          pure $ RnExprName rnName : rnObjAttrs
     [LS.MTT x] -> do
       rnName <- lookupOrInsertName (mkSimpleOccName x) RnVariable
       pure [RnExprName rnName]
@@ -492,11 +519,7 @@ renameDecideMultiTerm mt = do
           insertFunction f (FuncInfo{funcArity = (0, 2)})
           rnF <- lookupOrInsertName (mkSimpleOccName f) RnFunction
           pure $ [RnExprName rnF, RnExprName rnX, RnExprName rnY]
-    attrs@(_ : _)
-      | Just (obj, objAttrs) <- toObjectPath attrs -> do
-          rnName <- lookupOrInsertName (mkSimpleOccName obj) RnVariable
-          rnObjAttrs <- mapM (\attr -> RnExprName <$> lookupOrInsertName (mkSimpleOccName attr) RnSelector) objAttrs
-          pure $ RnExprName rnName : rnObjAttrs
+    [] -> throwError "renameDecideMultiTerm: Unexpected empty list of MultiTerm"
     unknownPattern -> throwError $ "While renaming a multi term in a top-level DECIDE clause, we encountered an unsupported pattern: " <> show unknownPattern
 
 -- | Check whether this could be a function like structure.
@@ -548,10 +571,24 @@ renameBoolStruct = \case
   AA.Not cs -> AA.Not <$> renameBoolStruct cs
 
 renameMultiTerm :: (MonadState Scope m, MonadError String m) => LS.MultiTerm -> m RnMultiTerm
-renameMultiTerm = mapM renameMultiTermExpression
+renameMultiTerm multiTerms = do
+  (results, _finalCtx) <-
+    foldM
+      ( \(results, state) mt -> do
+          (rnExpr, newState) <- renameMultiTermExpression state mt
+          pure (rnExpr : results, newState)
+      )
+      ([], initialMultiTermContext)
+      multiTerms
+  pure $ reverse results
+ where
+  initialMultiTermContext =
+    MultiTermContext
+      { _multiTermContextInSelector = False
+      }
 
-renameMultiTermExpression :: (MonadState Scope m, MonadError String m) => LS.MTExpr -> m RnExpr
-renameMultiTermExpression = \case
+renameMultiTermExpression :: (MonadState Scope m, MonadError String m) => MultiTermContext -> LS.MTExpr -> m (RnExpr, MultiTermContext)
+renameMultiTermExpression ctx = \case
   -- TODO: this could be an expression such as "2+2" (for whatever reason), so perhaps
   -- we need to parse this further. Allegedly, we also want to support
   -- expressions nested into one csv-cell, for example:
@@ -561,17 +598,20 @@ renameMultiTermExpression = \case
   -- where 'f' is a function.
   -- We ignore this for now, though.
   LS.MTT name -> case isGenitive name of
-    Nothing ->
+    Nothing -> do
       lookupName (mkSimpleOccName name) >>= \case
-        Just rnName -> pure $ RnExprName rnName
+        Just rnName -> pure (RnExprName rnName, notInSelectorContext ctx)
         Nothing
-          | isL4BuiltIn name -> RnExprName <$> rnL4Builtin name
+          | isL4BuiltIn name -> do
+              rnName <- RnExprName <$> rnL4Builtin name
+              pure (rnName, notInSelectorContext ctx)
+          | ctx ^. multiTermContextInSelector -> do
+              rnName <- RnExprName <$> insertName (mkSimpleOccName name) RnSelector
+              pure (rnName, notInSelectorContext ctx)
           | otherwise -> do
-              -- TODO: review, this feels wrong.
-              -- Perhaps renaming without context is simply not possible for an 'MTExpr'?
-              --
-              -- if this is not a known variable, let's assume it is a selector.
-              RnExprName <$> insertName (mkSimpleOccName name) RnSelector
+              -- If this is not a selector, or a known variable, we infer it is a string type.
+              -- TODO: only accept this, if the @name@ is enclosed in `"`.
+              pure (RnExprLit $ RnString name, notInSelectorContext ctx)
     Just nameSelector -> do
       -- Is this name known already?
       -- If not, we assume this is a selector we haven't encountered before.
@@ -583,10 +623,10 @@ renameMultiTermExpression = \case
       --
       -- Then 'y' and 'z' are anonymous selectors for 'x'.
       rnName <- fromMaybeM (lookupOrInsertName (mkSimpleOccName nameSelector) RnSelector) (lookupName (mkSimpleOccName nameSelector))
-      pure $ RnExprName rnName
-  LS.MTI int -> pure $ RnExprLit $ RnInt int
-  LS.MTF double -> pure $ RnExprLit $ RnDouble double
-  LS.MTB bool -> pure $ RnExprLit $ RnBool bool
+      pure (RnExprName rnName, inSelectorContext ctx)
+  LS.MTI int -> pure (RnExprLit $ RnInt int, notInSelectorContext ctx)
+  LS.MTF double -> pure (RnExprLit $ RnDouble double, notInSelectorContext ctx)
+  LS.MTB bool -> pure (RnExprLit $ RnBool bool, notInSelectorContext ctx)
 
 -- ----------------------------------------------------------------------------
 -- Builtins
@@ -670,6 +710,12 @@ assertEmptyList xs = throwError $ "Expected an empty list, but got: " <> show xs
 --
 -- >>> toObjectPath []
 -- Nothing
+--
+-- >>> toObjectPath [LS.MTT "y's"]
+-- Nothing
+--
+-- >>> toObjectPath [LS.MTT "y"]
+-- Nothing
 toObjectPath :: LS.MultiTerm -> Maybe (Text, [Text])
 toObjectPath [] = Nothing
 toObjectPath (varNameInGenitive : attrs) = do
@@ -679,7 +725,7 @@ toObjectPath (varNameInGenitive : attrs) = do
   pure (varName, textAttrs)
  where
   applyToInit :: (a -> Maybe a) -> [a] -> Maybe [a]
-  applyToInit _ [] = Just []
+  applyToInit _ [] = Nothing
   applyToInit _ [x] = Just [x]
   applyToInit f (x : xs) = (:) <$> f x <*> applyToInit f xs
 
@@ -695,10 +741,6 @@ genitiveSuffix = Text.pack "'s"
 -- TODO: don't merge this
 -- ----------------------------------------------------------------------------
 
-type Err = Either String
-type ParseFun a = [Parser.Token] -> Err a
-type Verbosity = Int
-
 run :: String -> Either String Rule
 run = fmap Parser.transRule . Parser.pRule . Parser.myLexer
 
diff --git a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
index c9bac01ac..9742a7c45 100644
--- a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
+++ b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
@@ -214,8 +214,8 @@ mergeGroups simalaTermGroups = do
   traverse mergeGroups' simalaTermGroups
 
 mergeGroups' :: (MonadError String m) => NonEmpty (SimalaTerm, Maybe Simala.Expr) -> m SimalaTerm
-mergeGroups' ((TermAttribute name [] expr, _) :| _) = pure $ TermLetIn Simala.Transparent name expr
-mergeGroups' terms@((TermAttribute name _ _, _) :| _) = do
+mergeGroups' ((TermAttribute name [] expr, Nothing) :| _) = pure $ TermLetIn Simala.Transparent name expr
+mergeGroups' terms@((TermAttribute name _ _, Nothing) :| _) = do
   rowUpdates <- traverse assertNonEmptyTermAttribute $ fmap fst $ NE.toList terms
   rowExprs <- traverse (pure . uncurry buildRecordUpdate) rowUpdates
   recordRows <- traverse assertIsRecord rowExprs
@@ -233,7 +233,7 @@ mergeGroups' ((term, Just g) :| (n : ns)) = do
 compareClauseHeads :: SimalaTerm -> SimalaTerm -> Bool
 compareClauseHeads (TermLetIn _ name1 _) (TermLetIn _ name2 _) = name1 == name2
 compareClauseHeads (TermFunction fnName1 _ _) (TermFunction fnName2 _ _) = fnName1 == fnName2
-compareClauseHeads (TermAttribute name1 _ _) (TermAttribute name2 _ _) = name1 == name2
+compareClauseHeads (TermAttribute name1 selectors1 _) (TermAttribute name2 selectors2 _) = name1 == name2 && selectors1 == selectors2
 compareClauseHeads _ _ = False
 
 -- ----------------------------------------------------------------------------
@@ -257,8 +257,8 @@ relationalPredicateToSimala = \case
     lhsSimalaExpr' <- lhsMultiTermToSimala lhs
     lhsSimalaExpr <- assertTermExpr lhsSimalaExpr'
     rhsSimalaExpr <- rhsMultiTermToSimala rhs
-    builtin <- fst <$> predRelToBuiltIn predicate
-    fixedArity builtin 2 [lhsSimalaExpr, rhsSimalaExpr]
+    (_builtin, builder) <- predRelToBuiltIn predicate
+    builder [lhsSimalaExpr, rhsSimalaExpr]
   RnNary LS.RPis (lhs : rhs) -> do
     multiTerm <- assertPredicateIsMultiTerm "relationalPredicateToSimala" lhs
     lhsSimalaTerm <- lhsMultiTermToSimala multiTerm
@@ -277,11 +277,14 @@ relationalPredicateToSimala = \case
       TermFunction{} -> throwError "Not implemented yet"
       TermExpr expr -> throwError $ "A saturated expression can't be left hand side: " <> show expr
   -- TODO: this is wrong, what about Var and Project?
-  RnNary relationalPredicate mt ->
-    predicateToSimala relationalPredicate mt
-  RnBoolStructR lhsExpr relationalPredicate bs -> do
-    lhsMultiTermToSimala lhsExpr
-  p -> throwError $ "Unhandled relational predicate: " <> show p
+  RnNary predicate mt ->
+    predicateToSimala predicate mt
+  RnBoolStructR lhs predicate rhs -> do
+    lhsTerm <- lhsMultiTermToSimala lhs
+    lhsExpr <- assertTermExpr lhsTerm
+    rhsSimalaExpr <- boolStructToSimala rhs
+    (_builtin, builder) <- predRelToBuiltIn predicate
+    builder [lhsExpr, rhsSimalaExpr]
 
 predicateToSimala :: (MonadError String m) => LS.RPRel -> [RnRelationalPredicate] -> m SimalaTerm
 predicateToSimala rp params' = do
@@ -392,13 +395,14 @@ isProjection mtHead args = do
 
 exprToSimala :: RnExpr -> Simala.Expr
 exprToSimala (RnExprName name) = Simala.Var $ toSimalaName name
-exprToSimala (RnExprLit lit) = Simala.Lit $ litToSimala lit
+exprToSimala (RnExprLit lit) = litToSimala lit
 
-litToSimala :: RnLit -> Simala.Lit
+litToSimala :: RnLit -> Simala.Expr
 litToSimala = \case
-  RnInt int -> Simala.IntLit $ fromIntegral int -- TODO: why does simala only support 'Int'?
+  RnInt int -> Simala.Lit $ Simala.IntLit $ fromIntegral int -- TODO: why does simala only support 'Int'?
   RnDouble _double -> error "Floating point numbers are unsupported in simala"
-  RnBool boolean -> Simala.BoolLit boolean
+  RnBool boolean -> Simala.Lit $ Simala.BoolLit boolean
+  RnString text -> Simala.Atom text
 
 isFunction :: RnExpr -> Maybe RnName
 isFunction expr = isExprOfType expr (RnFunction ==)
@@ -552,6 +556,10 @@ mkIfThenElse b (TermAttribute name1 selectors1 expr1) (TermAttribute name2 selec
   ifThenElseTerm <- fixedArity Simala.IfThenElse 3 [b, expr1, expr2]
   ifThenElse <- assertTermExpr ifThenElseTerm
   pure $ TermAttribute name1 selectors1 ifThenElse
+mkIfThenElse b (TermAttribute name1 selectors1 expr1) (TermExpr expr2) = do
+  ifThenElseTerm <- fixedArity Simala.IfThenElse 3 [b, expr1, expr2]
+  ifThenElse <- assertTermExpr ifThenElseTerm
+  pure $ TermAttribute name1 selectors1 ifThenElse
 mkIfThenElse b (TermFunction fnName1 fnParams1 expr1) (TermFunction fnName2 fnParams2 expr2) = do
   assertEquals fnName1 fnName2
   assertEquals fnParams1 fnParams2
@@ -622,18 +630,6 @@ mergeRecordUpdates xs = worker xs
     mergedRows <- worker recordRows
     pure $ (n, mergedRows)
 
--- [ (x, 4)]
--- [ (y, 5)]
--- [ (z, (a, (b, 5)))
--- , (z, (b, 4))
--- , (z, (a, (c, 5)))
--- ]
---
---
--- [ (z, [ (b, 4), (a, [(b, 5), (c, 5)]) ]) ]
-
--- { x=4; y=5; z = { a = { b = 5; c = 5 }; b = 4 }
-
 -- ----------------------------------------------------------------------------
 -- Test cases
 -- ----------------------------------------------------------------------------
@@ -757,10 +753,21 @@ WHERE
   y's p IS SUM(x, x)
 |]
 
--- >>> transpileRulePure decideWithConditionalAttributes
--- "relationalPredicateToSimala: Unsupported [RnExprName (RnName {rnOccName = MTT \"y's\" :| [], rnUniqueId = 3, rnNameType = RnFunction}),RnExprName (RnName {rnOccName = MTT \"z\" :| [], rnUniqueId = 2, rnNameType = RnSelector})]"
+-- >>> transpileRulePure decideWithSimpleConditionalAttributes
+-- "let f_f_3 = fun(v_x_0) => let v_y_1 = {s_z_2 = if v_x_0 > 3 then 5 else undefined} in v_y_1"
 
--- TODO: renamer bug, "y's" incorrectly
+decideWithSimpleConditionalAttributes :: String
+decideWithSimpleConditionalAttributes =
+  [i|
+GIVEN x
+DECIDE f x IS y
+WHERE
+  y's z IS 5 IF x > 3
+|]
+
+
+-- >>> transpileRulePure decideWithConditionalAttributes
+-- "Provided args are not equal: [\"s_z_2\"] /= [\"s_p_4\"]"
 
 decideWithConditionalAttributes :: String
 decideWithConditionalAttributes =
@@ -768,7 +775,7 @@ decideWithConditionalAttributes =
 GIVEN x
 DECIDE f x IS y
 WHERE
-  y's z IS 5 IF x > 5;
+  y's z IS 5 IF x > 3;
   y's z IS 0 OTHERWISE;
 
   y's p IS x IF x > 5;
@@ -782,7 +789,7 @@ WHERE
 --    y
 
 -- >>> transpileRulePure givethDefinition
--- "let v_y_0 = {s_z_1 = 5}\n"
+-- "let v_y_0 = {s_z_1 = 5}"
 
 givethDefinition :: String
 givethDefinition =
@@ -802,7 +809,7 @@ DECIDE y's a's b's c's z IS 5
 |]
 
 -- >>> transpileRulePure eragonBookDescription
--- "let v_eragon_0 = {s_character_4 = {s_friend_8 = s_Ork_9,s_main_5 = s_Eragon_2,s_villain_6 = s_Galbatorix_7},s_size_3 = 512,s_title_1 = s_Eragon_2}"
+-- "let v_eragon_0 = {s_character_3 = {s_friend_6 = 'Ork,s_main_4 = 'Eragon,s_villain_5 = 'Galbatorix},s_size_2 = 512,s_title_1 = 'Eragon}"
 
 -- TODO: Renamer bug: handle string literals
 
@@ -819,7 +826,7 @@ DECIDE
 |]
 
 -- >>> transpileRulePure eragonBookDescriptionWithWhere
--- "let v_eragon_0 = let v_localVar_1 = {s_character_5 = {s_friend_9 = s_Ork_10,s_main_6 = s_Eragon_3,s_villain_7 = s_Galbatorix_8},s_size_4 = 512,s_title_2 = s_Eragon_3} in v_localVar_1"
+-- "let v_eragon_0 = let v_localVar_1 = {s_character_4 = {s_friend_7 = 'Ork,s_main_5 = 'Eragon,s_villain_6 = 'Galbatorix},s_size_3 = 512,s_title_2 = 'Eragon} in v_localVar_1"
 
 -- TODO: Renamer bug: handle string literals
 
@@ -858,7 +865,7 @@ DECIDE y IS 5
 |]
 
 -- >>> transpileRulePure rodentsAndVermin
--- "relationalPredicateToSimala: Unsupported [RnExprName (RnName {rnOccName = MTT \"Loss or Damage\" :| [], rnUniqueId = 1, rnNameType = RnSelector})]"
+-- "Unsupported relational predicate: RPis"
 --
 rodentsAndVermin :: String
 rodentsAndVermin =

From 51b247fdc14ee96b851d8ebf63eba38f34ddb04e Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Tue, 6 Aug 2024 14:31:11 +0200
Subject: [PATCH 04/44] Fix transpiler for attributes with conditionals

Start documentation for the overall pipeline.
---
 .../natural4/src/LS/XPile/Simala/Transpile.hs | 116 ++++++++++++------
 1 file changed, 80 insertions(+), 36 deletions(-)

diff --git a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
index 9742a7c45..6b144009f 100644
--- a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
+++ b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
@@ -20,6 +20,7 @@ import Data.Text (Text)
 import Data.Text qualified as Text
 import Data.Text.IO qualified as Text
 import Data.Text.Lazy.IO qualified as TL
+import Data.Tuple.Extra qualified as Tuple
 import Debug.Trace
 import Optics
 import Text.Pretty.Simple qualified as Pretty
@@ -29,6 +30,7 @@ import LS.Renamer qualified as Renamer
 import LS.Types qualified as LS
 
 import AnyAll.BoolStruct qualified as AA
+import Data.List qualified as List
 import Simala.Expr.Render qualified as Simala
 import Simala.Expr.Type qualified as Simala
 
@@ -133,7 +135,6 @@ transpileRulePure ruleSrc =
           Right expr ->
             render expr
 
-
 render :: SimalaTerm -> Text
 render (TermExpr e) = Simala.render e
 render (TermLetIn _ name var) = "let " <> Simala.render name <> " = " <> Simala.render var
@@ -143,9 +144,7 @@ render (TermAttribute name [] expr) = "let " <> Simala.render name <> " = " <> S
 render (TermAttribute name (x : xs) expr) = "let " <> Simala.render name <> " = " <> Simala.render (buildRecordUpdate (x :| xs) expr)
 
 -- ----------------------------------------------------------------------------
--- Post Processing of rule transpilation
--- These steps include:
--- 1.
+-- Main translation helpers
 -- ----------------------------------------------------------------------------
 
 ruleToSimala :: (MonadError String m) => RnRule -> m SimalaTerm
@@ -155,6 +154,40 @@ ruleToSimala (Hornlike hornlike) = do
   subTerms <- traverse ruleToSimala hornlike.wwhere
   foldInSubTerms term subTerms
 
+-- ----------------------------------------------------------------------------
+-- Post Processing of rule translation.
+-- These steps include:
+--
+-- 1. Group terms for by their respective head clauses
+--    This aims to create a single function / definition for multiple decide clauses.
+--    These clauses can have bodies to express conditionals.
+--    For example, functions can be defined as:
+--
+--    @
+--      f x IS x IF x > 0;
+--      f x IS 0 OTHERWISE
+--    @
+--
+--    And we want to translate this to the Simala function:
+--    @let f = fun(x) => if x > 0 then x else 0@
+--
+--    Thus, we group by the clause head (e.g. @f x@) and "fold" the clause bodies
+--    into a chain of @if-then-else@ in Simala.
+--
+-- 2. Merge clause bodies referring to the same clause head.
+--    E.g. @[(f x, x, x > 0), (f x, 0, "OTHERWISE")]@ is translated
+--    to @(f x, if x > 0 then x else 0)@
+--
+--    A similar idea is applied for variable assignments and attribute decisions.
+--
+-- 3. At last, a hornlike rule has a 'WHERE' clause which contains arbitrary
+--    rules. For now, we assume these are hornlike rules themselves, which define
+--    functions and computations.
+--    These functions and computations need to be included in the definition of
+--    @f@, by "folding" them into the body of the function via nested @let-in@s.
+--
+-- ----------------------------------------------------------------------------
+
 hornClausesToSimala :: (MonadError String m) => [RnHornClause] -> m [SimalaTerm]
 hornClausesToSimala clauses = do
   simalaTerms <- traverse processClause clauses
@@ -168,14 +201,17 @@ hornClausesToSimala clauses = do
     hornBody <- traverse boolStructToSimala clause.rnHcBody
     pure (hornHead, hornBody)
 
-  groupClauses simalaTerms = do
-    NE.groupBy (compareClauseHeads `on` fst) simalaTerms
-
--- ----------------------------------------------------------------------------
--- Post Processing of rule translation.
--- These steps include:
--- 1.
--- ----------------------------------------------------------------------------
+-- | Group clauses and their respective bodies based on the similarity of the
+-- clause head.
+groupClauses :: (Foldable f) => f (SimalaTerm, Maybe Simala.Expr) -> [NonEmpty (SimalaTerm, Maybe Simala.Expr)]
+groupClauses simalaTerms = do
+  NE.groupBy (compareClauseHeads `on` fst) simalaTerms
+ where
+  compareClauseHeads :: SimalaTerm -> SimalaTerm -> Bool
+  compareClauseHeads (TermLetIn _ name1 _) (TermLetIn _ name2 _) = name1 == name2
+  compareClauseHeads (TermFunction fnName1 _ _) (TermFunction fnName2 _ _) = fnName1 == fnName2
+  compareClauseHeads (TermAttribute name1 _ _) (TermAttribute name2 _ _) = name1 == name2
+  compareClauseHeads _ _ = False
 
 foldInSubTerms :: forall m. (MonadError String m) => SimalaTerm -> [SimalaTerm] -> m SimalaTerm
 foldInSubTerms top [] = pure top
@@ -209,15 +245,23 @@ foldInSubTerms top (x : xs) = case top of
       TermFunction fnName fnParams fnExpr -> do
         pure $ mkLetIn Simala.Transparent fnName (Simala.Fun Simala.Transparent fnParams fnExpr) inExpr
 
+-- | Given a collection of groups, merge each group into a single expression.
 mergeGroups :: (Traversable t, MonadError String m) => t (NonEmpty (SimalaTerm, Maybe Simala.Expr)) -> m (t SimalaTerm)
 mergeGroups simalaTermGroups = do
   traverse mergeGroups' simalaTermGroups
 
+-- | Do the heavy lifting of how to actually merge multiple clauses into a single term.
 mergeGroups' :: (MonadError String m) => NonEmpty (SimalaTerm, Maybe Simala.Expr) -> m SimalaTerm
 mergeGroups' ((TermAttribute name [] expr, Nothing) :| _) = pure $ TermLetIn Simala.Transparent name expr
-mergeGroups' terms@((TermAttribute name _ _, Nothing) :| _) = do
-  rowUpdates <- traverse assertNonEmptyTermAttribute $ fmap fst $ NE.toList terms
-  rowExprs <- traverse (pure . uncurry buildRecordUpdate) rowUpdates
+mergeGroups' terms@((TermAttribute name _ _, _) :| _) = do
+  rowUpdates <-
+    traverse
+      (Tuple.firstM assertAttributeHasSelectors)
+      (NE.toList terms)
+  let
+    rowGroups = NE.groupWith (fst . fst) rowUpdates
+    rowGroups' = fmap simplifyAttributeAssignment rowGroups
+  rowExprs <- traverse (\(attrName, selectors) -> pure $ buildRecordUpdate attrName selectors) rowGroups'
   recordRows <- traverse assertIsRecord rowExprs
   treeRows <- mergeRecordUpdates recordRows
   pure $ TermLetIn Simala.Transparent name treeRows
@@ -230,11 +274,17 @@ mergeGroups' ((term, Just g) :| (n : ns)) = do
   elseBranch <- mergeGroups' (n :| ns)
   mkIfThenElse g term elseBranch
 
-compareClauseHeads :: SimalaTerm -> SimalaTerm -> Bool
-compareClauseHeads (TermLetIn _ name1 _) (TermLetIn _ name2 _) = name1 == name2
-compareClauseHeads (TermFunction fnName1 _ _) (TermFunction fnName2 _ _) = fnName1 == fnName2
-compareClauseHeads (TermAttribute name1 selectors1 _) (TermAttribute name2 selectors2 _) = name1 == name2 && selectors1 == selectors2
-compareClauseHeads _ _ = False
+simplifyAttributeAssignment :: NonEmpty ((NonEmpty Simala.Name, Simala.Expr), Maybe Simala.Expr) -> (NonEmpty Simala.Name, Simala.Expr)
+simplifyAttributeAssignment ((attributeAssignment, Nothing) :| []) = attributeAssignment
+simplifyAttributeAssignment (((attrPath, expr), Just guard) :| []) = (attrPath, Simala.Builtin Simala.IfThenElse [guard, expr, Simala.Undefined])
+simplifyAttributeAssignment (((attrPath, expr), guard) :| terms) =
+  let
+    exprWithGuard = fmap (\((_, expr), g) -> (expr, g)) terms
+    go _ (expr, Nothing) = (expr, Nothing)
+    go (expr2, newGuard) (expr, Just g) = (Simala.Builtin Simala.IfThenElse [g, expr, expr2], newGuard)
+    (newTerms, _) = List.foldr go (expr, guard) exprWithGuard
+  in
+    (attrPath, newTerms)
 
 -- ----------------------------------------------------------------------------
 -- Transpilation
@@ -390,7 +440,7 @@ isProjection mtHead args = do
   pure (varName, selectors)
 
 -- ----------------------------------------------------------------------------
--- Name translations
+-- Renamed Names utilities
 -- ----------------------------------------------------------------------------
 
 exprToSimala :: RnExpr -> Simala.Expr
@@ -506,10 +556,10 @@ assertIsRecord :: (MonadError String m) => Simala.Expr -> m (Simala.Row Simala.E
 assertIsRecord (Simala.Record row) = pure row
 assertIsRecord simalaExpr = throwError $ "Unexpected simala expression, expected Record but got: " <> show simalaExpr
 
-assertNonEmptyTermAttribute :: (MonadError String m) => SimalaTerm -> m (NonEmpty Simala.Name, Simala.Expr)
-assertNonEmptyTermAttribute (TermAttribute _ (x : xs) expr) = pure (x :| xs, expr)
-assertNonEmptyTermAttribute expr@(TermAttribute _ [] _) = throwError $ "Unexpected term, expected non-empty TermAttribute but got : " <> show expr
-assertNonEmptyTermAttribute expr = throwError $ "Unexpected term, expected non-empty TermAttribute but got : " <> show expr
+assertAttributeHasSelectors :: (MonadError String m) => SimalaTerm -> m (NonEmpty Simala.Name, Simala.Expr)
+assertAttributeHasSelectors (TermAttribute _ (x : xs) expr) = pure (x :| xs, expr)
+assertAttributeHasSelectors expr@(TermAttribute _ [] _) = throwError $ "Unexpected term, expected non-empty TermAttribute but got : " <> show expr
+assertAttributeHasSelectors expr = throwError $ "Unexpected term, expected non-empty TermAttribute but got : " <> show expr
 
 -- ----------------------------------------------------------------------------
 -- Construction helpers for simala terms
@@ -635,7 +685,7 @@ mergeRecordUpdates xs = worker xs
 -- ----------------------------------------------------------------------------
 
 -- >>> transpileRulePure exampleWithOneOf
--- "let f_g_6 = fun(v_d_0) => let v_y_1 = s_green_3 in v_y_1"
+-- "let f_g_4 = fun(v_d_0) => let v_y_1 = if v_d_0 > 0 then 'green else if b_OTHERWISE_3 then 'red else undefined in v_y_1"
 
 exampleWithOneOf :: String
 exampleWithOneOf =
@@ -649,7 +699,7 @@ WHERE
 |]
 
 -- >>> transpileRulePure bookWithAttributes
--- "relationalPredicateToSimala: Unsupported [RnExprName (RnName {rnOccName = MTT \"y's\" :| [], rnUniqueId = 4, rnNameType = RnFunction}),RnExprName (RnName {rnOccName = MTT \"book\" :| [], rnUniqueId = 2, rnNameType = RnSelector})]"
+-- "let f_g_4 = fun(v_d_0) => let v_y_1 = {s_book_2 = if v_d_0 > 0 then 'green else if b_OTHERWISE_3 then 'red else undefined} in v_y_1"
 
 bookWithAttributes :: String
 bookWithAttributes =
@@ -682,7 +732,7 @@ DECIDE sum3 x IS SUM(x, x, x)
 |]
 
 -- >>> transpileRulePure simpleSelector
--- "let f_f_1 = fun(v_x_0) => v_x_0.s_z_2\n"
+-- "let f_f_1 = fun(v_x_0) => v_x_0.s_z_2"
 
 simpleSelector :: String
 simpleSelector =
@@ -765,9 +815,8 @@ WHERE
   y's z IS 5 IF x > 3
 |]
 
-
 -- >>> transpileRulePure decideWithConditionalAttributes
--- "Provided args are not equal: [\"s_z_2\"] /= [\"s_p_4\"]"
+-- "let f_f_5 = fun(v_x_0) => let v_y_1 = {s_p_4 = if v_x_0 > 5 then v_x_0 else v_x_0 + v_x_0,s_z_2 = if v_x_0 > 3 then 5 else 0} in v_y_1"
 
 decideWithConditionalAttributes :: String
 decideWithConditionalAttributes =
@@ -785,7 +834,7 @@ WHERE
 -- let f = fun(x) =>
 --    let y_z = if x > 5 then 5 else 0 in
 --    let y_p = if x > 5 then x else sum(x, x) in
---    let y = { z = y_s, p = y_p } in
+--    let y = { z = y_z, p = y_p } in
 --    y
 
 -- >>> transpileRulePure givethDefinition
@@ -811,8 +860,6 @@ DECIDE y's a's b's c's z IS 5
 -- >>> transpileRulePure eragonBookDescription
 -- "let v_eragon_0 = {s_character_3 = {s_friend_6 = 'Ork,s_main_4 = 'Eragon,s_villain_5 = 'Galbatorix},s_size_2 = 512,s_title_1 = 'Eragon}"
 
--- TODO: Renamer bug: handle string literals
-
 eragonBookDescription :: String
 eragonBookDescription =
   [i|
@@ -828,8 +875,6 @@ DECIDE
 -- >>> transpileRulePure eragonBookDescriptionWithWhere
 -- "let v_eragon_0 = let v_localVar_1 = {s_character_4 = {s_friend_7 = 'Ork,s_main_5 = 'Eragon,s_villain_6 = 'Galbatorix},s_size_3 = 512,s_title_2 = 'Eragon} in v_localVar_1"
 
--- TODO: Renamer bug: handle string literals
-
 eragonBookDescriptionWithWhere :: String
 eragonBookDescriptionWithWhere =
   [i|
@@ -895,4 +940,3 @@ IF
                 )
         )
 |]
-

From c33aa9c8c000719b09aca521922f7c47696c9ef7 Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Tue, 6 Aug 2024 14:49:36 +0200
Subject: [PATCH 05/44] Renamer cleanup of imports and traces

---
 lib/haskell/natural4/src/LS/Renamer.hs                | 10 ++++------
 lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs |  3 +--
 2 files changed, 5 insertions(+), 8 deletions(-)

diff --git a/lib/haskell/natural4/src/LS/Renamer.hs b/lib/haskell/natural4/src/LS/Renamer.hs
index 27e2ea83e..16badc704 100644
--- a/lib/haskell/natural4/src/LS/Renamer.hs
+++ b/lib/haskell/natural4/src/LS/Renamer.hs
@@ -10,7 +10,6 @@
 module LS.Renamer where
 
 import AnyAll.BoolStruct qualified as AA
-import L4.Lexer qualified as Parser
 import LS.Rule (Rule, RuleLabel)
 import LS.Rule qualified as Rule
 import LS.Types (MyToken, RuleName, SrcRef)
@@ -32,7 +31,6 @@ import Data.Set qualified as Set
 import Data.Text (Text)
 import Data.Text qualified as Text
 import Data.Text.Lazy.IO qualified as TL
-import Debug.Trace (traceShowId)
 import GHC.Generics (Generic)
 import Optics
 import Text.Pretty.Simple qualified as Pretty
@@ -217,9 +215,6 @@ lookupOrInsertName occName nameType = do
 insertName :: (MonadState Scope m) => OccName -> RnNameType -> m RnName
 insertName occName nameType = do
   n <- newUniqueM
-  -- TODO: error handling, would we accept an enum such as `a IS ONE OF 1, 2, 3`?
-  -- Only if we treat them as text, which might be confusing, as user might infer
-  -- this to be some kind of type checked number type.
   let
     rnName =
       RnName
@@ -382,6 +377,9 @@ renameTypeSignature sig = case sig of
     rnEntityType <- renameEntityType entityType
     pure $ RnSimpleType pType rnEntityType
   LS.InlineEnum pType paramText -> do
+    -- TODO: error handling, would we accept an enum such as `a IS ONE OF 1, 2, 3`?
+    -- Only if we treat them as text, which might be confusing, as user might infer
+    -- this to be some kind of type checked number type.
     rnParamText <- renameGivenInlineEnumParamText paramText
     pure $ RnInlineEnum pType rnParamText
  where
@@ -427,7 +425,7 @@ renameTypeSignature sig = case sig of
             , rnTypedMultiTypeSig = Nothing
             }
 
-    rnParams <- mapM renameEach $ traceShowId params
+    rnParams <- mapM renameEach params
     pure $ RnParamText rnParams
 
 renameHornClause :: (MonadState Scope m, MonadError String m) => LS.HornClause2 -> m RnHornClause
diff --git a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
index 6b144009f..37cc083c8 100644
--- a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
+++ b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
@@ -21,7 +21,6 @@ import Data.Text qualified as Text
 import Data.Text.IO qualified as Text
 import Data.Text.Lazy.IO qualified as TL
 import Data.Tuple.Extra qualified as Tuple
-import Debug.Trace
 import Optics
 import Text.Pretty.Simple qualified as Pretty
 
@@ -216,11 +215,11 @@ groupClauses simalaTerms = do
 foldInSubTerms :: forall m. (MonadError String m) => SimalaTerm -> [SimalaTerm] -> m SimalaTerm
 foldInSubTerms top [] = pure top
 foldInSubTerms top (x : xs) = case top of
+  TermExpr{} -> throwError $ "foldInSubTerms: Unexpected SimalaTerm: " <> show top
   TermApp{} -> throwError $ "foldInSubTerms: Unexpected SimalaTerm: " <> show top
   TermLetIn t name expr -> do
     exprWithLocals <- linearLetIns expr (x :| xs)
     pure $ TermLetIn t name exprWithLocals
-  TermExpr{} -> throwError $ "foldInSubTerms: Unexpected SimalaTerm: " <> show top
   TermAttribute name selectors expr -> do
     exprWithLocals <- linearLetIns expr (x :| xs)
     pure $ TermAttribute name selectors exprWithLocals

From dc57d8d79b265a60c03b194e2399914a63beef1d Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Tue, 6 Aug 2024 16:35:01 +0200
Subject: [PATCH 06/44] Add support for quotes for string literals

---
 lib/haskell/natural4/src/LS/Renamer.hs | 46 +++++++++++++++++---------
 1 file changed, 30 insertions(+), 16 deletions(-)

diff --git a/lib/haskell/natural4/src/LS/Renamer.hs b/lib/haskell/natural4/src/LS/Renamer.hs
index 16badc704..86c089180 100644
--- a/lib/haskell/natural4/src/LS/Renamer.hs
+++ b/lib/haskell/natural4/src/LS/Renamer.hs
@@ -167,7 +167,7 @@ data BindingScope
 
 data ScopeTable = ScopeTable
   { _stVariables :: Map OccName RnName
-  , _stFunction :: Map FuncOccName FuncInfo
+  , _stFunction :: Map RnName FuncInfo
   }
   deriving (Eq, Ord, Show)
 
@@ -230,19 +230,19 @@ insertName occName nameType = do
       .~ Just rnName
   pure rnName
 
-insertFunction :: (MonadState Scope m) => FuncOccName -> FuncInfo -> m ()
-insertFunction funcOccName funcInfo = do
+insertFunction :: (MonadState Scope m) => RnName -> FuncInfo -> m ()
+insertFunction rnFnName funcInfo = do
   State.modify' $ \s ->
     s
       & scScopeTable
       % stFunction
-      % at funcOccName
+      % at rnFnName
       .~ Just funcInfo
 
-lookupFunction :: (MonadState Scope m) => FuncOccName -> m (Maybe FuncInfo)
-lookupFunction funcOccName =
+lookupFunction :: (MonadState Scope m) => RnName -> m (Maybe FuncInfo)
+lookupFunction rnFnName =
   State.gets $ \s ->
-    s ^. scScopeTable % stFunction % at funcOccName
+    s ^. scScopeTable % stFunction % at rnFnName
 
 -- ----------------------------------------------------------------------------
 -- Helper types for local context
@@ -288,7 +288,8 @@ renameRuleTopLevel' rule =
 -- Resolve functions and their respective arities
 -- ----------------------------------------------------------------------------
 
--- fixRuleArity :: (MonadState Scope m, MonadError String m) => Rule -> m RnRule
+-- fixFunctionFixity :: (MonadState Scope m, MonadError String m) => RnRule -> m RnRule
+-- fixFunctionFixity
 
 -- ----------------------------------------------------------------------------
 -- Renamer passes
@@ -304,10 +305,11 @@ renameRule rule@Rule.Hornlike{} = do
   defaults <- assertEmptyList rule.defaults
   symtab <- assertEmptyList rule.symtab
   clauses <- traverse renameHornClause rule.clauses
+  name <- renameMultiTerm rule.name
   pure $
     Hornlike
       RnHornlike
-        { name = []
+        { name = name
         , super = super
         , keyword = rule.keyword
         , given = given
@@ -390,7 +392,7 @@ renameTypeSignature sig = case sig of
     -- 'EntityType's with the same name over the whole program.
     lookupOrInsertName (mkSimpleOccName eType) RnType
 
-  -- Why not reuse 'renameParamText'? It is basically the same type!
+  -- Why not reuse 'renameGivens'? It is basically the same type!
   -- Well, we don't handle arbitrary nested type signatures.
   -- In fact, it is a bit dubious we have them at all!
   -- The following seems to be possible in theory:
@@ -499,23 +501,23 @@ renameDecideMultiTerm mt = do
       pure [RnExprName rnName]
     [LS.MTT f, LS.MTT x]
       | Just [rnX] <- variableAndFunction scopeTable [x] f -> do
-          insertFunction f (FuncInfo{funcArity = (0, 1)})
           rnF <- lookupOrInsertName (mkSimpleOccName f) RnFunction
+          insertFunction rnF (FuncInfo{funcArity = (0, 1)})
           pure $ [RnExprName rnF, RnExprName rnX]
     [LS.MTT x, LS.MTT f]
       | Just [rnX] <- variableAndFunction scopeTable [x] f -> do
-          insertFunction f (FuncInfo{funcArity = (1, 0)})
           rnF <- lookupOrInsertName (mkSimpleOccName f) RnFunction
+          insertFunction rnF (FuncInfo{funcArity = (1, 0)})
           pure $ [RnExprName rnF, RnExprName rnX]
     [LS.MTT x, LS.MTT f, LS.MTT y]
       | Just [rnX, rnY] <- variableAndFunction scopeTable [x, y] f -> do
-          insertFunction f (FuncInfo{funcArity = (1, 1)})
           rnF <- lookupOrInsertName (mkSimpleOccName f) RnFunction
+          insertFunction rnF (FuncInfo{funcArity = (1, 1)})
           pure $ [RnExprName rnF, RnExprName rnX, RnExprName rnY]
     [LS.MTT f, LS.MTT x, LS.MTT y]
       | Just [rnX, rnY] <- variableAndFunction scopeTable [x, y] f -> do
-          insertFunction f (FuncInfo{funcArity = (0, 2)})
           rnF <- lookupOrInsertName (mkSimpleOccName f) RnFunction
+          insertFunction rnF (FuncInfo{funcArity = (0, 2)})
           pure $ [RnExprName rnF, RnExprName rnX, RnExprName rnY]
     [] -> throwError "renameDecideMultiTerm: Unexpected empty list of MultiTerm"
     unknownPattern -> throwError $ "While renaming a multi term in a top-level DECIDE clause, we encountered an unsupported pattern: " <> show unknownPattern
@@ -600,6 +602,8 @@ renameMultiTermExpression ctx = \case
       lookupName (mkSimpleOccName name) >>= \case
         Just rnName -> pure (RnExprName rnName, notInSelectorContext ctx)
         Nothing
+          | Just literal <- isTextLiteral name ->
+              pure (RnExprLit $ RnString literal, notInSelectorContext ctx)
           | isL4BuiltIn name -> do
               rnName <- RnExprName <$> rnL4Builtin name
               pure (rnName, notInSelectorContext ctx)
@@ -607,8 +611,11 @@ renameMultiTermExpression ctx = \case
               rnName <- RnExprName <$> insertName (mkSimpleOccName name) RnSelector
               pure (rnName, notInSelectorContext ctx)
           | otherwise -> do
-              -- If this is not a selector, or a known variable, we infer it is a string type.
-              -- TODO: only accept this, if the @name@ is enclosed in `"`.
+              -- If this is not a selector, or a known variable, we infer
+              -- it is a string type. This is ok, because users can
+              -- disambiguate variables and string literals by enclosing the
+              -- literal in quotes, e.g. @"This is a string"@
+              --
               pure (RnExprLit $ RnString name, notInSelectorContext ctx)
     Just nameSelector -> do
       -- Is this name known already?
@@ -625,6 +632,13 @@ renameMultiTermExpression ctx = \case
   LS.MTI int -> pure (RnExprLit $ RnInt int, notInSelectorContext ctx)
   LS.MTF double -> pure (RnExprLit $ RnDouble double, notInSelectorContext ctx)
   LS.MTB bool -> pure (RnExprLit $ RnBool bool, notInSelectorContext ctx)
+ where
+  -- There is no doubt this is a text literal, if it is enclosed in quotes.
+  -- Strips away the quotes.
+  isTextLiteral t = do
+    ('"', t') <- uncons t
+    (t'', '"') <- unsnoc t'
+    pure t''
 
 -- ----------------------------------------------------------------------------
 -- Builtins

From 8180280239ef2f22d24f779b542b403f765c3021 Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Tue, 6 Aug 2024 16:35:21 +0200
Subject: [PATCH 07/44] Simplify and improve variable / attribute assignment

---
 .../natural4/src/LS/XPile/Simala/Transpile.hs | 106 ++++++++++++++----
 1 file changed, 82 insertions(+), 24 deletions(-)

diff --git a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
index 37cc083c8..64c4f4646 100644
--- a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
+++ b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
@@ -251,39 +251,74 @@ mergeGroups simalaTermGroups = do
 
 -- | Do the heavy lifting of how to actually merge multiple clauses into a single term.
 mergeGroups' :: (MonadError String m) => NonEmpty (SimalaTerm, Maybe Simala.Expr) -> m SimalaTerm
-mergeGroups' ((TermAttribute name [] expr, Nothing) :| _) = pure $ TermLetIn Simala.Transparent name expr
 mergeGroups' terms@((TermAttribute name _ _, _) :| _) = do
-  rowUpdates <-
+  attributeTerms <-
     traverse
-      (Tuple.firstM assertAttributeHasSelectors)
-      (NE.toList terms)
-  let
-    rowGroups = NE.groupWith (fst . fst) rowUpdates
-    rowGroups' = fmap simplifyAttributeAssignment rowGroups
-  rowExprs <- traverse (\(attrName, selectors) -> pure $ buildRecordUpdate attrName selectors) rowGroups'
-  recordRows <- traverse assertIsRecord rowExprs
-  treeRows <- mergeRecordUpdates recordRows
-  pure $ TermLetIn Simala.Transparent name treeRows
+      ( \(term, guard) -> do
+          (_, attrs, expr) <- assertIsTermAttribute term
+          pure (attrs, expr, guard)
+      )
+      terms
+  mergeAttributes name attributeTerms
 mergeGroups' ((term, Nothing) :| _) =
   pure term
 mergeGroups' ((term, Just g) :| []) = do
-  ifThenElseTerm <- mkIfThenElse g term (TermExpr Simala.Undefined)
+  ifThenElseTerm <- mkIfThenElse g term mkUndefinedTerm
   pure ifThenElseTerm
 mergeGroups' ((term, Just g) :| (n : ns)) = do
   elseBranch <- mergeGroups' (n :| ns)
   mkIfThenElse g term elseBranch
 
-simplifyAttributeAssignment :: NonEmpty ((NonEmpty Simala.Name, Simala.Expr), Maybe Simala.Expr) -> (NonEmpty Simala.Name, Simala.Expr)
-simplifyAttributeAssignment ((attributeAssignment, Nothing) :| []) = attributeAssignment
-simplifyAttributeAssignment (((attrPath, expr), Just guard) :| []) = (attrPath, Simala.Builtin Simala.IfThenElse [guard, expr, Simala.Undefined])
-simplifyAttributeAssignment (((attrPath, expr), guard) :| terms) =
+mergeAttributes :: (MonadError String m) => Simala.Name -> NonEmpty ([Simala.Name], Simala.Expr, Maybe Simala.Expr) -> m SimalaTerm
+mergeAttributes name terms = do
+  let
+    initSelectors = NE.head terms ^. _1
+
+  case initSelectors of
+    [] -> do
+      simpleTerms <-
+        traverse
+          ( \(selector, expr, guard) -> do
+              _ <- assertEmptyList selector
+              pure (expr, guard)
+          )
+          terms
+      pure $ TermLetIn Simala.Transparent name $ toIfThenElseChain simpleTerms
+    (_ : _) -> do
+      rowTerms <-
+        traverse
+          ( \(selector, expr, guard) -> do
+              nonEmptySelectors <- assertNonEmpty selector
+              pure (nonEmptySelectors, expr, guard)
+          )
+          terms
+      let
+        rowGroups = NE.groupWith (^. _1) rowTerms
+        rowGroups' = fmap reduceAttrPaths rowGroups
+      rowExprs <- traverse (\(attrName, expr) -> pure $ buildRecordUpdate attrName expr) rowGroups'
+      recordRows <- traverse assertIsRecord rowExprs
+      treeRows <- mergeRecordUpdates recordRows
+      pure $ TermLetIn Simala.Transparent name treeRows
+ where
+  reduceAttrPaths attrs =
+    let
+      attrPath = NE.head attrs ^. _1
+      exprs = fmap (\(_, selectors, guards) -> (selectors, guards)) attrs
+    in
+      (attrPath, toIfThenElseChain exprs)
+
+toIfThenElseChain :: NonEmpty (Simala.Expr, Maybe Simala.Expr) -> Simala.Expr
+toIfThenElseChain ((expr, Nothing) :| []) = expr
+toIfThenElseChain ((expr, Just guard) :| []) =
+  Simala.Builtin Simala.IfThenElse [guard, expr, Simala.Undefined]
+toIfThenElseChain ((expr, guard) :| terms) =
   let
-    exprWithGuard = fmap (\((_, expr), g) -> (expr, g)) terms
-    go _ (expr, Nothing) = (expr, Nothing)
-    go (expr2, newGuard) (expr, Just g) = (Simala.Builtin Simala.IfThenElse [g, expr, expr2], newGuard)
-    (newTerms, _) = List.foldr go (expr, guard) exprWithGuard
+    elseExpr = case terms of
+      (x : xs) -> toIfThenElseChain (x :| xs)
   in
-    (attrPath, newTerms)
+    case guard of
+      Nothing -> expr
+      Just g -> Simala.Builtin Simala.IfThenElse [g, expr, elseExpr]
 
 -- ----------------------------------------------------------------------------
 -- Transpilation
@@ -501,6 +536,10 @@ rnNameTypePrefix = \case
 -- Assertion helpers
 -- ----------------------------------------------------------------------------
 
+assertIsTermAttribute :: (MonadError String m) => SimalaTerm -> m (Simala.Name, [Simala.Name], Simala.Expr)
+assertIsTermAttribute (TermAttribute name selectors expr) = pure (name, selectors, expr)
+assertIsTermAttribute term = throwError $ "Expected TermAttribute but got: " <> show term
+
 assertSingletonList :: (MonadError String m) => String -> [a] -> m a
 assertSingletonList _errMsg [a] = pure a
 assertSingletonList errMsg as =
@@ -538,6 +577,10 @@ assertLength l as =
             <> show (length as)
       else pure as
 
+assertNonEmpty :: (MonadError String m) => [a] -> m (NonEmpty a)
+assertNonEmpty [] = throwError "Expected non-empty list"
+assertNonEmpty (x : xs) = pure $ x :| xs
+
 assertPredicateIsMultiTerm :: (MonadError String m) => String -> RnRelationalPredicate -> m RnMultiTerm
 assertPredicateIsMultiTerm _errMsg (RnRelationalTerm mt) = pure mt
 assertPredicateIsMultiTerm errMsg predicate = throwError $ errMsg <> "\nExpected RnRelationalTerm but got: " <> show predicate
@@ -557,13 +600,16 @@ assertIsRecord simalaExpr = throwError $ "Unexpected simala expression, expected
 
 assertAttributeHasSelectors :: (MonadError String m) => SimalaTerm -> m (NonEmpty Simala.Name, Simala.Expr)
 assertAttributeHasSelectors (TermAttribute _ (x : xs) expr) = pure (x :| xs, expr)
-assertAttributeHasSelectors expr@(TermAttribute _ [] _) = throwError $ "Unexpected term, expected non-empty TermAttribute but got : " <> show expr
-assertAttributeHasSelectors expr = throwError $ "Unexpected term, expected non-empty TermAttribute but got : " <> show expr
+assertAttributeHasSelectors expr@(TermAttribute _ [] _) = throwError $ "Unexpected term, expected non-empty TermAttribute but got: " <> show expr
+assertAttributeHasSelectors expr = throwError $ "Unexpected term, expected non-empty TermAttribute but got: " <> show expr
 
 -- ----------------------------------------------------------------------------
 -- Construction helpers for simala terms
 -- ----------------------------------------------------------------------------
 
+mkUndefinedTerm :: SimalaTerm
+mkUndefinedTerm = TermExpr Simala.Undefined
+
 mkAssignment :: (MonadError String m) => Simala.Name -> [Simala.Name] -> Simala.Expr -> m SimalaTerm
 mkAssignment name selectors expr = pure $ TermAttribute name selectors expr
 
@@ -683,6 +729,18 @@ mergeRecordUpdates xs = worker xs
 -- Test cases
 -- ----------------------------------------------------------------------------
 
+-- >>> transpileRulePure outputWithIndirection
+-- "let v_x_0 = let v_y_1 = 5 in v_y_1"
+
+outputWithIndirection :: String
+outputWithIndirection =
+  [i|
+GIVETH x
+DECIDE x IS y
+WHERE
+    y IS 5
+|]
+
 -- >>> transpileRulePure exampleWithOneOf
 -- "let f_g_4 = fun(v_d_0) => let v_y_1 = if v_d_0 > 0 then 'green else if b_OTHERWISE_3 then 'red else undefined in v_y_1"
 
@@ -815,7 +873,7 @@ WHERE
 |]
 
 -- >>> transpileRulePure decideWithConditionalAttributes
--- "let f_f_5 = fun(v_x_0) => let v_y_1 = {s_p_4 = if v_x_0 > 5 then v_x_0 else v_x_0 + v_x_0,s_z_2 = if v_x_0 > 3 then 5 else 0} in v_y_1"
+-- "let f_f_5 = fun(v_x_0) => let v_y_1 = {s_p_4 = if v_x_0 > 5 then v_x_0 else if b_OTHERWISE_3 then v_x_0 + v_x_0 else undefined,s_z_2 = if v_x_0 > 3 then 5 else if b_OTHERWISE_3 then 0 else undefined} in v_y_1"
 
 decideWithConditionalAttributes :: String
 decideWithConditionalAttributes =

From cbf4095582a03a2ed5e3a8fa71d4c89b26fd34d7 Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Wed, 7 Aug 2024 11:05:20 +0200
Subject: [PATCH 08/44] Unify attribute assignment codepath in the Renamer

---
 lib/haskell/natural4/src/LS/Renamer.hs | 11 ++++++-----
 1 file changed, 6 insertions(+), 5 deletions(-)

diff --git a/lib/haskell/natural4/src/LS/Renamer.hs b/lib/haskell/natural4/src/LS/Renamer.hs
index 86c089180..d758ca16d 100644
--- a/lib/haskell/natural4/src/LS/Renamer.hs
+++ b/lib/haskell/natural4/src/LS/Renamer.hs
@@ -491,14 +491,11 @@ renameDecideMultiTerm :: (MonadState Scope m, MonadError String m) => LS.MultiTe
 renameDecideMultiTerm mt = do
   scopeTable <- State.gets _scScopeTable
   case mt of
-    attrs@(_ : _)
+    attrs
       | Just (obj, objAttrs) <- toObjectPath attrs -> do
           rnName <- lookupOrInsertName (mkSimpleOccName obj) RnVariable
           rnObjAttrs <- mapM (\attr -> RnExprName <$> lookupOrInsertName (mkSimpleOccName attr) RnSelector) objAttrs
           pure $ RnExprName rnName : rnObjAttrs
-    [LS.MTT x] -> do
-      rnName <- lookupOrInsertName (mkSimpleOccName x) RnVariable
-      pure [RnExprName rnName]
     [LS.MTT f, LS.MTT x]
       | Just [rnX] <- variableAndFunction scopeTable [x] f -> do
           rnF <- lookupOrInsertName (mkSimpleOccName f) RnFunction
@@ -727,9 +724,13 @@ assertEmptyList xs = throwError $ "Expected an empty list, but got: " <> show xs
 -- Nothing
 --
 -- >>> toObjectPath [LS.MTT "y"]
--- Nothing
+-- Just ("y",[])
+--
 toObjectPath :: LS.MultiTerm -> Maybe (Text, [Text])
 toObjectPath [] = Nothing
+toObjectPath [LS.MTT varName] = case isGenitive varName of
+  Nothing -> Just (varName, [])
+  Just _ -> Nothing
 toObjectPath (varNameInGenitive : attrs) = do
   varName <- LS.isMtexprText varNameInGenitive >>= isGenitive
   textAttrsInGenitive <- traverse LS.isMtexprText attrs

From 80609eb27da8d2d61812e20cb00351bfc95a9c33 Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Wed, 7 Aug 2024 11:05:36 +0200
Subject: [PATCH 09/44] Remove debugger helpers for the renamer

---
 lib/haskell/natural4/src/LS/Renamer.hs | 13 -------------
 1 file changed, 13 deletions(-)

diff --git a/lib/haskell/natural4/src/LS/Renamer.hs b/lib/haskell/natural4/src/LS/Renamer.hs
index d758ca16d..956722494 100644
--- a/lib/haskell/natural4/src/LS/Renamer.hs
+++ b/lib/haskell/natural4/src/LS/Renamer.hs
@@ -14,8 +14,6 @@ import LS.Rule (Rule, RuleLabel)
 import LS.Rule qualified as Rule
 import LS.Types (MyToken, RuleName, SrcRef)
 import LS.Types qualified as LS
-import TextuaL4.ParTextuaL qualified as Parser
-import TextuaL4.Transform qualified as Parser
 
 import Control.Monad.Error.Class
 import Control.Monad.Extra (foldM, fromMaybeM)
@@ -748,14 +746,3 @@ isGenitive = Text.stripSuffix genitiveSuffix
 
 genitiveSuffix :: Text
 genitiveSuffix = Text.pack "'s"
-
--- ----------------------------------------------------------------------------
--- Example data for debugging.
--- TODO: don't merge this
--- ----------------------------------------------------------------------------
-
-run :: String -> Either String Rule
-run = fmap Parser.transRule . Parser.pRule . Parser.myLexer
-
-runList :: String -> Either String [Rule]
-runList = fmap (fmap Parser.transRule) . Parser.pListRule . Parser.myLexer

From 91767c7832b52b9b0bb1413e0964f56061b3094f Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Wed, 7 Aug 2024 11:05:58 +0200
Subject: [PATCH 10/44] Move debugging code around

---
 .../natural4/src/LS/XPile/Simala/Transpile.hs | 99 +++++++++++--------
 1 file changed, 56 insertions(+), 43 deletions(-)

diff --git a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
index 64c4f4646..fbc2dde78 100644
--- a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
+++ b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
@@ -20,16 +20,17 @@ import Data.Text (Text)
 import Data.Text qualified as Text
 import Data.Text.IO qualified as Text
 import Data.Text.Lazy.IO qualified as TL
-import Data.Tuple.Extra qualified as Tuple
 import Optics
 import Text.Pretty.Simple qualified as Pretty
 
+import qualified LS.Rule as LS
+import qualified TextuaL4.Transform as Parser
+import qualified TextuaL4.ParTextuaL as Parser
 import LS.Renamer
 import LS.Renamer qualified as Renamer
 import LS.Types qualified as LS
 
 import AnyAll.BoolStruct qualified as AA
-import Data.List qualified as List
 import Simala.Expr.Render qualified as Simala
 import Simala.Expr.Type qualified as Simala
 
@@ -99,48 +100,7 @@ data SimalaTerm
 -- Top Level transpilation functions and test helpers
 -- ----------------------------------------------------------------------------
 
-transpileRule :: String -> IO ()
-transpileRule ruleSrc = do
-  rule <- case Renamer.run ruleSrc of
-    Left err -> do
-      putStrLn err
-      error ""
-    Right r -> pure r
-  TL.putStrLn $ Pretty.pShow rule
-  let
-    (res, s) = renameRuleTopLevel' rule
-  TL.putStrLn $ Pretty.pShow s
-  case res of
-    Left err -> putStrLn err
-    Right rnRule -> do
-      TL.putStrLn $ Pretty.pShow rnRule
-      simalaTerms <- runExceptT $ ruleToSimala rnRule
-      case simalaTerms of
-        Left err -> putStrLn err
-        Right expr -> do
-          Text.putStrLn $ "Expr: " <> render expr
 
-transpileRulePure :: String -> Text
-transpileRulePure ruleSrc =
-  let
-    Right rule = Renamer.run ruleSrc
-    (res, _s) = renameRuleTopLevel' rule
-  in
-    case res of
-      Left err -> Text.pack err
-      Right rnRule -> do
-        case runExcept $ ruleToSimala rnRule of
-          Left err -> Text.pack err
-          Right expr ->
-            render expr
-
-render :: SimalaTerm -> Text
-render (TermExpr e) = Simala.render e
-render (TermLetIn _ name var) = "let " <> Simala.render name <> " = " <> Simala.render var
-render (TermApp name params) = Simala.render name <> "(" <> Text.intercalate ", " (fmap Simala.render params) <> ")"
-render (TermFunction name params expr) = "let " <> Simala.render name <> " = fun(" <> Text.intercalate ", " (fmap Simala.render params) <> ") => " <> Simala.render expr
-render (TermAttribute name [] expr) = "let " <> Simala.render name <> " = " <> Simala.render expr
-render (TermAttribute name (x : xs) expr) = "let " <> Simala.render name <> " = " <> Simala.render (buildRecordUpdate (x :| xs) expr)
 
 -- ----------------------------------------------------------------------------
 -- Main translation helpers
@@ -997,3 +957,56 @@ IF
                 )
         )
 |]
+
+-- ----------------------------------------------------------------------------
+-- Debugger helpers
+-- ----------------------------------------------------------------------------
+
+debugTranspileRule :: String -> IO ()
+debugTranspileRule ruleSrc = do
+  rule <- case run ruleSrc of
+    Left err -> do
+      putStrLn err
+      error ""
+    Right r -> pure r
+  TL.putStrLn $ Pretty.pShow rule
+  let
+    (res, s) = renameRuleTopLevel' rule
+  TL.putStrLn $ Pretty.pShow s
+  case res of
+    Left err -> putStrLn err
+    Right rnRule -> do
+      TL.putStrLn $ Pretty.pShow rnRule
+      simalaTerms <- runExceptT $ ruleToSimala rnRule
+      case simalaTerms of
+        Left err -> putStrLn err
+        Right expr -> do
+          Text.putStrLn $ "Expr: " <> render expr
+
+transpileRulePure :: String -> Text
+transpileRulePure ruleSrc =
+  let
+    Right rule = run ruleSrc
+    (res, _s) = renameRuleTopLevel' rule
+  in
+    case res of
+      Left err -> Text.pack err
+      Right rnRule -> do
+        case runExcept $ ruleToSimala rnRule of
+          Left err -> Text.pack err
+          Right expr ->
+            render expr
+
+render :: SimalaTerm -> Text
+render (TermExpr e) = Simala.render e
+render (TermLetIn _ name var) = "let " <> Simala.render name <> " = " <> Simala.render var
+render (TermApp name params) = Simala.render name <> "(" <> Text.intercalate ", " (fmap Simala.render params) <> ")"
+render (TermFunction name params expr) = "let " <> Simala.render name <> " = fun(" <> Text.intercalate ", " (fmap Simala.render params) <> ") => " <> Simala.render expr
+render (TermAttribute name [] expr) = "let " <> Simala.render name <> " = " <> Simala.render expr
+render (TermAttribute name (x : xs) expr) = "let " <> Simala.render name <> " = " <> Simala.render (buildRecordUpdate (x :| xs) expr)
+
+run :: String -> Either String LS.Rule
+run = fmap Parser.transRule . Parser.pRule . Parser.myLexer
+
+runList :: String -> Either String [LS.Rule]
+runList = fmap (fmap Parser.transRule) . Parser.pListRule . Parser.myLexer

From 71c234886da5da419010b953199e45bb458615eb Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Wed, 7 Aug 2024 11:55:06 +0200
Subject: [PATCH 11/44] Prefer concrete monad stack

---
 lib/haskell/natural4/src/LS/Renamer.hs | 73 ++++++++++++--------------
 1 file changed, 35 insertions(+), 38 deletions(-)

diff --git a/lib/haskell/natural4/src/LS/Renamer.hs b/lib/haskell/natural4/src/LS/Renamer.hs
index 956722494..4357520d5 100644
--- a/lib/haskell/natural4/src/LS/Renamer.hs
+++ b/lib/haskell/natural4/src/LS/Renamer.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedRecordDot #-}
@@ -19,7 +21,9 @@ import Control.Monad.Error.Class
 import Control.Monad.Extra (foldM, fromMaybeM)
 import Control.Monad.State.Class qualified as State
 import Control.Monad.State.Strict (MonadState)
+import Control.Monad.Trans.Except (ExceptT)
 import Control.Monad.Trans.Except qualified as Except
+import Control.Monad.Trans.State.Strict (State)
 import Control.Monad.Trans.State.Strict qualified as State (runState)
 import Data.List.NonEmpty (NonEmpty)
 import Data.List.NonEmpty qualified as NE
@@ -132,10 +136,12 @@ data RnRelationalPredicate
 -- Scope tables
 -- ----------------------------------------------------------------------------
 
-type StVariable = Text
+newtype Renamer a = Renamer {runRenamer :: ExceptT String (State Scope) a}
+  deriving (Functor, Applicative, Monad)
+  deriving newtype (MonadState Scope, MonadError String)
+
 type Unique = Int
 type OccName = NonEmpty LS.MTExpr
-type FuncOccName = Text
 
 data FuncInfo = FuncInfo
   { funcArity :: (Int, Int)
@@ -186,18 +192,18 @@ emptyScope =
 prefixScope :: RuleName -> Scope -> Scope
 prefixScope = undefined
 
-newUniqueM :: (MonadState Scope m) => m Unique
+newUniqueM :: Renamer Unique
 newUniqueM = do
   u <- State.gets _scUnique
   State.modify' (\s -> s & scUnique %~ (+ 1))
   pure u
 
-lookupName :: (MonadState Scope m) => OccName -> m (Maybe RnName)
+lookupName :: OccName -> Renamer (Maybe RnName)
 lookupName occName = do
   st <- State.gets _scScopeTable
   pure $ Map.lookup occName (_stVariables st)
 
-lookupOrInsertName :: (MonadState Scope m, MonadError String m) => OccName -> RnNameType -> m RnName
+lookupOrInsertName :: OccName -> RnNameType -> Renamer RnName
 lookupOrInsertName occName nameType = do
   lookupName occName >>= \case
     Nothing -> insertName occName nameType
@@ -210,7 +216,7 @@ lookupOrInsertName occName nameType = do
               <> " but expected: "
               <> show (rnNameType name)
 
-insertName :: (MonadState Scope m) => OccName -> RnNameType -> m RnName
+insertName :: OccName -> RnNameType -> Renamer RnName
 insertName occName nameType = do
   n <- newUniqueM
   let
@@ -228,7 +234,7 @@ insertName occName nameType = do
       .~ Just rnName
   pure rnName
 
-insertFunction :: (MonadState Scope m) => RnName -> FuncInfo -> m ()
+insertFunction :: RnName -> FuncInfo -> Renamer ()
 insertFunction rnFnName funcInfo = do
   State.modify' $ \s ->
     s
@@ -237,7 +243,7 @@ insertFunction rnFnName funcInfo = do
       % at rnFnName
       .~ Just funcInfo
 
-lookupFunction :: (MonadState Scope m) => RnName -> m (Maybe FuncInfo)
+lookupFunction :: RnName -> Renamer (Maybe FuncInfo)
 lookupFunction rnFnName =
   State.gets $ \s ->
     s ^. scScopeTable % stFunction % at rnFnName
@@ -280,7 +286,7 @@ renameRuleTopLevel rule = do
 
 renameRuleTopLevel' :: Rule -> (Either String RnRule, Scope)
 renameRuleTopLevel' rule =
-  State.runState (Except.runExceptT (renameRule rule)) emptyScope
+  State.runState (Except.runExceptT (runRenamer $ renameRule rule)) emptyScope
 
 -- ----------------------------------------------------------------------------
 -- Resolve functions and their respective arities
@@ -293,7 +299,7 @@ renameRuleTopLevel' rule =
 -- Renamer passes
 -- ----------------------------------------------------------------------------
 
-renameRule :: (MonadState Scope m, MonadError String m) => Rule -> m RnRule
+renameRule :: Rule -> Renamer RnRule
 renameRule rule@Rule.Hornlike{} = do
   super <- traverse renameTypeSignature rule.super
   given <- renameGivens rule.given
@@ -334,25 +340,19 @@ renameRule r@Rule.RegBreach{} = throwError $ "Unsupported rule: " <> show r
 renameRule r@Rule.NotARule{} = throwError $ "Unsupported rule: " <> show r
 
 renameUpons ::
-  forall m.
-  (MonadState Scope m, MonadError String m) =>
   Maybe LS.ParamText ->
-  m (Maybe RnParamText)
+  Renamer (Maybe RnParamText)
 renameUpons Nothing = pure Nothing
 renameUpons (Just xs) = throwError $ "Unsupported \"UPON\", got: " <> show xs
 
 renameGiveths ::
-  forall m.
-  (MonadState Scope m, MonadError String m) =>
   Maybe LS.ParamText ->
-  m (Maybe RnParamText)
+  Renamer (Maybe RnParamText)
 renameGiveths = renameGivens
 
 renameGivens ::
-  forall m.
-  (MonadState Scope m, MonadError String m) =>
   Maybe LS.ParamText ->
-  m (Maybe RnParamText)
+  Renamer (Maybe RnParamText)
 renameGivens Nothing = pure Nothing
 renameGivens (Just givens) = do
   rnGivens <- mapM renameGiven givens
@@ -368,10 +368,8 @@ renameGivens (Just givens) = do
     insertName (pure mt) RnVariable
 
 renameTypeSignature ::
-  forall m.
-  (MonadState Scope m, MonadError String m) =>
   LS.TypeSig ->
-  m RnTypeSig
+  Renamer RnTypeSig
 renameTypeSignature sig = case sig of
   LS.SimpleType pType entityType -> do
     rnEntityType <- renameEntityType entityType
@@ -383,7 +381,7 @@ renameTypeSignature sig = case sig of
     rnParamText <- renameGivenInlineEnumParamText paramText
     pure $ RnInlineEnum pType rnParamText
  where
-  renameEntityType :: LS.EntityType -> m RnEntityType
+  renameEntityType :: LS.EntityType -> Renamer RnEntityType
   renameEntityType eType =
     -- This is might be a new entity type. However, we allow ad-hoc type definitions.
     -- Thus, insert a new entity type. This definition defines one name for all
@@ -412,7 +410,7 @@ renameTypeSignature sig = case sig of
   -- TODO: We reuse this for Type declarations as well, are nested type signatures allowed in this case?
   -- Even in that case, since 'TypeDecl''s 'has' is a list of 'TypeDecl''s, it seems like
   -- there is no arbitrary nesting.
-  renameGivenInlineEnumParamText :: LS.ParamText -> m RnParamText
+  renameGivenInlineEnumParamText :: LS.ParamText -> Renamer RnParamText
   renameGivenInlineEnumParamText params = do
     let
       renameEach tm = do
@@ -428,7 +426,7 @@ renameTypeSignature sig = case sig of
     rnParams <- mapM renameEach params
     pure $ RnParamText rnParams
 
-renameHornClause :: (MonadState Scope m, MonadError String m) => LS.HornClause2 -> m RnHornClause
+renameHornClause :: LS.HornClause2 -> Renamer RnHornClause
 renameHornClause hc = do
   rnHead <- renameDecideHeadClause hc.hHead
   rnBody <- traverse renameBoolStruct hc.hBody
@@ -438,7 +436,7 @@ renameHornClause hc = do
       , rnHcBody = rnBody
       }
 
-renameDecideHeadClause :: (MonadState Scope m, MonadError String m) => LS.RelationalPredicate -> m RnRelationalPredicate
+renameDecideHeadClause :: LS.RelationalPredicate -> Renamer RnRelationalPredicate
 renameDecideHeadClause = \case
   LS.RPParamText pText -> throwError $ "Received 'RPParamText', we can't handle that yet. Got: " <> show pText
   LS.RPMT mt -> RnRelationalTerm <$> renameDecideMultiTerm mt
@@ -485,7 +483,7 @@ renameDecideHeadClause = \case
 -- * @x@: a variable, might be bound ad-hoc
 --
 -- Note, this doesn't accept literals such as '42' or '3.5f'.
-renameDecideMultiTerm :: (MonadState Scope m, MonadError String m) => LS.MultiTerm -> m RnMultiTerm
+renameDecideMultiTerm :: LS.MultiTerm -> Renamer RnMultiTerm
 renameDecideMultiTerm mt = do
   scopeTable <- State.gets _scScopeTable
   case mt of
@@ -538,7 +536,7 @@ variableAndFunction st variables function = do
       | otherwise -> Nothing
     Nothing -> Just rnBoundVariables
 
-renameRelationalPredicate :: (MonadState Scope m, MonadError String m) => LS.RelationalPredicate -> m RnRelationalPredicate
+renameRelationalPredicate :: LS.RelationalPredicate -> Renamer RnRelationalPredicate
 renameRelationalPredicate = \case
   LS.RPParamText pText -> throwError $ "Received 'RPParamText', we can't handle that yet. Got: " <> show pText
   LS.RPMT mt -> RnRelationalTerm <$> renameMultiTerm mt
@@ -554,7 +552,7 @@ renameRelationalPredicate = \case
     rnRhs <- traverse renameRelationalPredicate rhs
     pure $ RnNary relationalPredicate rnRhs
 
-renameBoolStruct :: (MonadState Scope m, MonadError String m) => LS.BoolStructR -> m RnBoolStructR
+renameBoolStruct :: LS.BoolStructR -> Renamer RnBoolStructR
 renameBoolStruct = \case
   AA.Leaf p -> AA.Leaf <$> renameRelationalPredicate p
   AA.All lbl cs -> do
@@ -565,7 +563,7 @@ renameBoolStruct = \case
     pure $ AA.Any lbl rnBoolStruct
   AA.Not cs -> AA.Not <$> renameBoolStruct cs
 
-renameMultiTerm :: (MonadState Scope m, MonadError String m) => LS.MultiTerm -> m RnMultiTerm
+renameMultiTerm :: LS.MultiTerm -> Renamer RnMultiTerm
 renameMultiTerm multiTerms = do
   (results, _finalCtx) <-
     foldM
@@ -582,7 +580,7 @@ renameMultiTerm multiTerms = do
       { _multiTermContextInSelector = False
       }
 
-renameMultiTermExpression :: (MonadState Scope m, MonadError String m) => MultiTermContext -> LS.MTExpr -> m (RnExpr, MultiTermContext)
+renameMultiTermExpression :: MultiTermContext -> LS.MTExpr -> Renamer (RnExpr, MultiTermContext)
 renameMultiTermExpression ctx = \case
   -- TODO: this could be an expression such as "2+2" (for whatever reason), so perhaps
   -- we need to parse this further. Allegedly, we also want to support
@@ -642,7 +640,7 @@ renameMultiTermExpression ctx = \case
 isL4BuiltIn :: Text -> Bool
 isL4BuiltIn name = Set.member name (Set.fromList l4Builtins)
 
-rnL4Builtin :: (MonadState Scope m, MonadError String m) => Text -> m RnName
+rnL4Builtin :: Text -> Renamer RnName
 rnL4Builtin name = do
   lookupOrInsertName (mkSimpleOccName name) RnBuiltin
 
@@ -662,25 +660,25 @@ oTHERWISE = "OTHERWISE"
 --
 -- TODO: This is lossy, we can't reconstruct the 'NonEmpty LS.MTExpr' given the
 -- text. Fix this! It is likely wrong, too.
-assertMultiExprIsOnlyText :: (MonadError String m) => NonEmpty LS.MTExpr -> m Text
+assertMultiExprIsOnlyText :: NonEmpty LS.MTExpr -> Renamer Text
 assertMultiExprIsOnlyText mtt = do
   xs <- traverse assertExprIsText mtt
   pure $ Text.unwords $ NE.toList xs
 
-assertSingletonMultiTerm :: (MonadError String m) => NonEmpty LS.MTExpr -> m LS.MTExpr
+assertSingletonMultiTerm :: NonEmpty LS.MTExpr -> Renamer LS.MTExpr
 assertSingletonMultiTerm (x NE.:| []) = pure x
 assertSingletonMultiTerm xs = throwError $ "Expected singleton but got: " <> show xs
 
-assertMultiExprIsText :: (MonadError String m) => NonEmpty LS.MTExpr -> m Text
+assertMultiExprIsText :: NonEmpty LS.MTExpr -> Renamer Text
 assertMultiExprIsText mts = do
   mt <- assertSingletonMultiTerm mts
   assertExprIsText mt
 
-assertExprIsText :: (MonadError String m) => LS.MTExpr -> m Text
+assertExprIsText :: LS.MTExpr -> Renamer Text
 assertExprIsText (LS.MTT t) = pure t
 assertExprIsText mt = throwError $ "Expected MTT but got: " <> show mt
 
-assertNoTypeSignature :: (MonadError String m) => LS.TypedMulti -> m (NonEmpty LS.MTExpr)
+assertNoTypeSignature :: LS.TypedMulti -> Renamer (NonEmpty LS.MTExpr)
 assertNoTypeSignature tm@(_, Just _) = throwError $ "Expected no type signature but got: " <> show tm
 assertNoTypeSignature (mtt, Nothing) = do
   pure mtt
@@ -723,7 +721,6 @@ assertEmptyList xs = throwError $ "Expected an empty list, but got: " <> show xs
 --
 -- >>> toObjectPath [LS.MTT "y"]
 -- Just ("y",[])
---
 toObjectPath :: LS.MultiTerm -> Maybe (Text, [Text])
 toObjectPath [] = Nothing
 toObjectPath [LS.MTT varName] = case isGenitive varName of

From bfe46f848da29a19dfa02598f2ce4e73237b0e91 Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Wed, 7 Aug 2024 12:10:03 +0200
Subject: [PATCH 12/44] Add initial testsuite for Simala transpilation

---
 lib/haskell/.gitignore                        |   2 +-
 lib/haskell/natural4/natural4.cabal           |   1 +
 lib/haskell/natural4/test/LS/RenamerSpec.hs   | 110 +++++-----
 .../natural4/test/LS/XPile/SimalaSpec.hs      |  84 ++++++++
 .../TextuaL4Spec/hornlike-2-giveths.expected  |  47 +++++
 .../golden/decide-with-attributes.expected    |   1 -
 .../test/testdata/golden/id-func.expected     |   1 -
 .../renamer/decide-with-attributes.expected   | 196 ++++++++++++++++++
 .../testdata/golden/renamer/id-func.expected  |  83 ++++++++
 .../xpile/simala/bookWithAttributes.expected  |   2 +
 .../testdata/golden/xpile/simala/id.expected  |   1 +
 11 files changed, 471 insertions(+), 57 deletions(-)
 create mode 100644 lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
 create mode 100644 lib/haskell/natural4/test/testdata/golden/TextuaL4Spec/hornlike-2-giveths.expected
 delete mode 100644 lib/haskell/natural4/test/testdata/golden/decide-with-attributes.expected
 delete mode 100644 lib/haskell/natural4/test/testdata/golden/id-func.expected
 create mode 100644 lib/haskell/natural4/test/testdata/golden/renamer/decide-with-attributes.expected
 create mode 100644 lib/haskell/natural4/test/testdata/golden/renamer/id-func.expected
 create mode 100644 lib/haskell/natural4/test/testdata/golden/xpile/simala/bookWithAttributes.expected
 create mode 100644 lib/haskell/natural4/test/testdata/golden/xpile/simala/id.expected

diff --git a/lib/haskell/.gitignore b/lib/haskell/.gitignore
index ecb3c7d23..bf72a6969 100644
--- a/lib/haskell/.gitignore
+++ b/lib/haskell/.gitignore
@@ -24,7 +24,7 @@ out/
 workdir/
 
 ## ignore the expected golden files output
-**/test/testdata/golden/*.actual
+**/test/testdata/golden/**/*.actual
 
 ## Configurations
 .vscode/
diff --git a/lib/haskell/natural4/natural4.cabal b/lib/haskell/natural4/natural4.cabal
index 771db4d58..ea8cadc8b 100644
--- a/lib/haskell/natural4/natural4.cabal
+++ b/lib/haskell/natural4/natural4.cabal
@@ -449,6 +449,7 @@ test-suite natural4-test
       LS.XPile.JSONSchemaSpec
       LS.XPile.LogicalEnglishSpec
       LS.XPile.PrologSpec
+      LS.XPile.SimalaSpec
       Parsing.BoolStructParserSpec
       Parsing.CoreL4ParserSpec
       Parsing.MegaparsingMeansSpec
diff --git a/lib/haskell/natural4/test/LS/RenamerSpec.hs b/lib/haskell/natural4/test/LS/RenamerSpec.hs
index a9fcf10c1..c322cea1f 100644
--- a/lib/haskell/natural4/test/LS/RenamerSpec.hs
+++ b/lib/haskell/natural4/test/LS/RenamerSpec.hs
@@ -1,74 +1,76 @@
-
 {-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 
-module LS.RenamerSpec(spec) where
-
+module LS.RenamerSpec (spec) where
 
-import LS.Rule
-import LS.Types
-import TextuaL4.Transform
-import TextuaL4.LexTextuaL   ( Token )
-import TextuaL4.ParTextuaL   ( pRule, pListRule, myLexer )
-import Text.Pretty.Simple ( pShowNoColor )
-import Text.RawString.QQ ( r )
-import Data.List ( intercalate )
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Except qualified as Except
+import Control.Monad.Trans.State.Strict qualified as State
+import Data.Either (fromRight)
+import Data.List (intercalate)
 import Data.Text.Lazy qualified as TL
 import Data.Text.Lazy.IO qualified as TL
-import System.FilePath ( (<.>), (</>) )
-import Test.Hspec.Golden
+import LS.Renamer qualified as Renamer
+import LS.Rule
+import LS.Types
+import System.FilePath ((<.>), (</>))
 import Test.Hspec (Spec, describe, it, shouldBe)
-import Data.Either (fromRight)
-import qualified LS.Renamer as Renamer
-import qualified Control.Monad.Trans.State.Strict as State
-import Control.Monad.IO.Class
-import qualified Control.Monad.Trans.Except as Except
-
+import Test.Hspec.Golden
+import Text.Pretty.Simple (pShowNoColor)
+import Text.RawString.QQ (r)
+import TextuaL4.LexTextuaL (Token)
+import TextuaL4.ParTextuaL (myLexer, pListRule, pRule)
+import TextuaL4.Transform
 
-goldenGeneric :: Show a => String -> a -> Golden TL.Text
-goldenGeneric name output_ = Golden
-  { output = pShowNoColor output_
-  , encodePretty = TL.unpack
-  , writeToFile = TL.writeFile
-  , readFromFile = TL.readFile
-  , goldenFile =  testPath <.> "expected"
-  , actualFile = Just (testPath <.> "actual")
-  , failFirstTime = False
-  }
-  where
-    testPath = "test" </> "testdata" </> "golden" </> name
+goldenGeneric :: (Show a) => String -> a -> Golden TL.Text
+goldenGeneric name output_ =
+  Golden
+    { output = pShowNoColor output_
+    , encodePretty = TL.unpack
+    , writeToFile = TL.writeFile
+    , readFromFile = TL.readFile
+    , goldenFile = testPath <.> "expected"
+    , actualFile = Just (testPath <.> "actual")
+    , failFirstTime = False
+    }
+ where
+  testPath = "test" </> "testdata" </> "golden" </> "renamer" </> name
 
 spec :: Spec
 spec = do
   describe "Renamer" do
-    test' bookWithAttributes "Book Attributes" "decide-with-attributes"
-    test' idFunction "Id Function" "id-func"
-  where
-    test rule = test' rule rule
-
-    test' ruleSource desc fname = do
-      let rule :: Rule = fromRight RegBreach $ run ruleSource
-      let rnRule :: Either String Renamer.RnRule =
-            Except.runExcept (State.evalStateT (Renamer.renameRule rule) Renamer.emptyScope)
-      it desc $ goldenGeneric fname $ rnRule
-
-bookWithAttributes = [r|
-GIVEN d DECIDE g d IS y
-WHERE
-    y's book IS green IF d > 0;
-    y's book IS red OTHERWISE
-|]
+    test'
+      "Book Attributes"
+      "decide-with-attributes"
+      [r|
+        GIVEN d DECIDE g d IS y
+        WHERE
+            y's book IS green IF d > 0;
+            y's book IS red OTHERWISE
+        |]
+    test'
+      "Id Function"
+      "id-func"
+      [r|
+        GIVEN x
+        DECIDE id x IS x
+        |]
+ where
+  test rule = test' rule rule
 
-idFunction = [r|
-GIVEN x
-DECIDE id x IS x
-|]
+  test' desc fname ruleSource = do
+    let
+      rule :: Rule = fromRight RegBreach $ run ruleSource
+    let
+      rnRule :: Either String Renamer.RnRule =
+        State.evalState (Except.runExceptT (Renamer.runRenamer $ Renamer.renameRule rule)) Renamer.emptyScope
+    it desc $ goldenGeneric fname $ rnRule
 
-type Err        = Either String
+type Err = Either String
 type ParseFun a = [Token] -> Err a
-type Verbosity  = Int
+type Verbosity = Int
 
 run :: String -> Either String Rule
 run = fmap transRule . pRule . myLexer
diff --git a/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs b/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
new file mode 100644
index 000000000..9e426901e
--- /dev/null
+++ b/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
@@ -0,0 +1,84 @@
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+module LS.XPile.SimalaSpec (spec) where
+
+import Base (runExceptT)
+import Control.Monad.Trans.Except (runExcept)
+import Data.String.Interpolate
+import Data.Text qualified as Text
+import Data.Text.Lazy qualified as TL
+import Data.Text.Lazy.IO qualified as TL
+import LS.Renamer qualified as Renamer
+import LS.Rule
+import LS.XPile.Logging (pShowNoColorS)
+import LS.XPile.Simala.Transpile qualified as Simala
+import System.FilePath
+import Test.Hspec
+import Test.Hspec.Golden
+import Text.Pretty.Simple qualified as Pretty
+import TextuaL4.ParTextuaL qualified as Parser
+import TextuaL4.Transform qualified as Parser
+
+spec :: Spec
+spec = do
+  describe "rule transpilation" do
+    it "id" $
+      runSimalaTranspilerForRule
+        "id"
+        [i|
+            GIVEN x
+            DECIDE id x IS x
+            |]
+
+    it "bookWithAttributes" $
+      runSimalaTranspilerForRule
+        "bookWithAttributes"
+        [i|
+            GIVEN d
+            DECIDE g d IS y
+            WHERE
+                y's book IS green IF d > 0;
+                y's book IS red OTHERWISE
+            |]
+
+runSimalaTranspilerForRule :: String -> String -> Golden TL.Text
+runSimalaTranspilerForRule outputName ruleString = goldenGeneric outputName $
+  case run ruleString of
+    Left err -> "Failed to parse program:\n" <> ruleString
+    Right rule -> do
+      case Renamer.renameRuleTopLevel' rule of
+        (Left err, scope) ->
+          unlines
+            [ "Renaming failed for program:"
+            , ruleString
+            , "Because:"
+            , err
+            , "Scope table:"
+            , pShowNoColorS scope
+            ]
+        (Right rnRule, _) -> do
+          case runExcept (Simala.ruleToSimala rnRule) of
+            Left err -> "Failed transpilation:\n" <> err
+            Right simala -> Text.unpack $ Simala.render simala
+
+goldenGeneric :: String -> String -> Golden TL.Text
+goldenGeneric name output_ =
+  Golden
+    { output = Pretty.pStringNoColor output_
+    , encodePretty = TL.unpack
+    , writeToFile = TL.writeFile
+    , readFromFile = TL.readFile
+    , goldenFile = testPath <.> "expected"
+    , actualFile = Just (testPath <.> "actual")
+    , failFirstTime = False
+    }
+ where
+  testPath = "test" </> "testdata" </> "golden" </> "xpile" </> "simala" </> name
+
+run :: String -> Either String Rule
+run = fmap Parser.transRule . Parser.pRule . Parser.myLexer
+
+runList :: String -> Either String [Rule]
+runList = fmap (fmap Parser.transRule) . Parser.pListRule . Parser.myLexer
diff --git a/lib/haskell/natural4/test/testdata/golden/TextuaL4Spec/hornlike-2-giveths.expected b/lib/haskell/natural4/test/testdata/golden/TextuaL4Spec/hornlike-2-giveths.expected
new file mode 100644
index 000000000..e8f550ad6
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/TextuaL4Spec/hornlike-2-giveths.expected
@@ -0,0 +1,47 @@
+Hornlike
+    { name =
+        [ MTT "x" ]
+    , super = Nothing
+    , keyword = Decide
+    , given = Nothing
+    , giveth = Just
+        (
+            ( MTT "x" :| []
+            , Nothing
+            ) :|
+            [
+                ( MTT "y" :| []
+                , Nothing
+                )
+            ]
+        )
+    , upon = Nothing
+    , clauses =
+        [ HC
+            { hHead = RPConstraint
+                [ MTT "x" ] RPis
+                [ MTI 5 ]
+            , hBody = Nothing
+            }
+        , HC
+            { hHead = RPConstraint
+                [ MTT "y" ] RPis
+                [ MTI 4 ]
+            , hBody = Nothing
+            }
+        ]
+    , rlabel = Nothing
+    , lsource = Nothing
+    , wwhere = []
+    , srcref = Just
+        ( SrcRef
+            { url = "test/Spec"
+            , short = "test/Spec"
+            , srcrow = 1
+            , srccol = 1
+            , version = Nothing
+            }
+        )
+    , defaults = []
+    , symtab = []
+    }
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/decide-with-attributes.expected b/lib/haskell/natural4/test/testdata/golden/decide-with-attributes.expected
deleted file mode 100644
index 9be9bcf84..000000000
--- a/lib/haskell/natural4/test/testdata/golden/decide-with-attributes.expected
+++ /dev/null
@@ -1 +0,0 @@
-Nothing
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/id-func.expected b/lib/haskell/natural4/test/testdata/golden/id-func.expected
deleted file mode 100644
index 9be9bcf84..000000000
--- a/lib/haskell/natural4/test/testdata/golden/id-func.expected
+++ /dev/null
@@ -1 +0,0 @@
-Nothing
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/renamer/decide-with-attributes.expected b/lib/haskell/natural4/test/testdata/golden/renamer/decide-with-attributes.expected
new file mode 100644
index 000000000..3c020cbac
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/renamer/decide-with-attributes.expected
@@ -0,0 +1,196 @@
+Right
+    ( Hornlike
+        ( RnHornlike
+            { name =
+                [ RnExprName
+                    ( RnName
+                        { rnOccName = MTT "g" :| []
+                        , rnUniqueId = 4
+                        , rnNameType = RnFunction
+                        }
+                    )
+                , RnExprName
+                    ( RnName
+                        { rnOccName = MTT "d" :| []
+                        , rnUniqueId = 0
+                        , rnNameType = RnVariable
+                        }
+                    )
+                ]
+            , super = Nothing
+            , keyword = Decide
+            , given = Just
+                ( RnParamText
+                    { mkParamText = RnTypedMulti
+                        { rnTypedMultiExpr = RnExprName
+                            ( RnName
+                                { rnOccName = MTT "d" :| []
+                                , rnUniqueId = 0
+                                , rnNameType = RnVariable
+                                }
+                            ) :| []
+                        , rnTypedMultiTypeSig = Nothing
+                        } :| []
+                    }
+                )
+            , giveth = Nothing
+            , upon = Nothing
+            , clauses =
+                [ RnHornClause
+                    { rnHcHead = RnConstraint
+                        [ RnExprName
+                            ( RnName
+                                { rnOccName = MTT "g" :| []
+                                , rnUniqueId = 4
+                                , rnNameType = RnFunction
+                                }
+                            )
+                        , RnExprName
+                            ( RnName
+                                { rnOccName = MTT "d" :| []
+                                , rnUniqueId = 0
+                                , rnNameType = RnVariable
+                                }
+                            )
+                        ] RPis
+                        [ RnExprName
+                            ( RnName
+                                { rnOccName = MTT "y" :| []
+                                , rnUniqueId = 1
+                                , rnNameType = RnVariable
+                                }
+                            )
+                        ]
+                    , rnHcBody = Nothing
+                    }
+                ]
+            , rlabel = Nothing
+            , lsource = Nothing
+            , wwhere =
+                [ Hornlike
+                    ( RnHornlike
+                        { name =
+                            [ RnExprName
+                                ( RnName
+                                    { rnOccName = MTT "y" :| []
+                                    , rnUniqueId = 1
+                                    , rnNameType = RnVariable
+                                    }
+                                )
+                            , RnExprName
+                                ( RnName
+                                    { rnOccName = MTT "book" :| []
+                                    , rnUniqueId = 2
+                                    , rnNameType = RnSelector
+                                    }
+                                )
+                            ]
+                        , super = Nothing
+                        , keyword = Where
+                        , given = Nothing
+                        , giveth = Nothing
+                        , upon = Nothing
+                        , clauses =
+                            [ RnHornClause
+                                { rnHcHead = RnConstraint
+                                    [ RnExprName
+                                        ( RnName
+                                            { rnOccName = MTT "y" :| []
+                                            , rnUniqueId = 1
+                                            , rnNameType = RnVariable
+                                            }
+                                        )
+                                    , RnExprName
+                                        ( RnName
+                                            { rnOccName = MTT "book" :| []
+                                            , rnUniqueId = 2
+                                            , rnNameType = RnSelector
+                                            }
+                                        )
+                                    ] RPis
+                                    [ RnExprLit
+                                        ( RnString "green" )
+                                    ]
+                                , rnHcBody = Just
+                                    ( Leaf
+                                        ( RnConstraint
+                                            [ RnExprName
+                                                ( RnName
+                                                    { rnOccName = MTT "d" :| []
+                                                    , rnUniqueId = 0
+                                                    , rnNameType = RnVariable
+                                                    }
+                                                )
+                                            ] RPgt
+                                            [ RnExprLit
+                                                ( RnInt 0 )
+                                            ]
+                                        )
+                                    )
+                                }
+                            , RnHornClause
+                                { rnHcHead = RnConstraint
+                                    [ RnExprName
+                                        ( RnName
+                                            { rnOccName = MTT "y" :| []
+                                            , rnUniqueId = 1
+                                            , rnNameType = RnVariable
+                                            }
+                                        )
+                                    , RnExprName
+                                        ( RnName
+                                            { rnOccName = MTT "book" :| []
+                                            , rnUniqueId = 2
+                                            , rnNameType = RnSelector
+                                            }
+                                        )
+                                    ] RPis
+                                    [ RnExprLit
+                                        ( RnString "red" )
+                                    ]
+                                , rnHcBody = Just
+                                    ( Leaf
+                                        ( RnRelationalTerm
+                                            [ RnExprName
+                                                ( RnName
+                                                    { rnOccName = MTT "OTHERWISE" :| []
+                                                    , rnUniqueId = 3
+                                                    , rnNameType = RnBuiltin
+                                                    }
+                                                )
+                                            ]
+                                        )
+                                    )
+                                }
+                            ]
+                        , rlabel = Nothing
+                        , lsource = Nothing
+                        , wwhere = []
+                        , srcref = Just
+                            ( SrcRef
+                                { url = "test/Spec"
+                                , short = "test/Spec"
+                                , srcrow = 1
+                                , srccol = 1
+                                , version = Nothing
+                                }
+                            )
+                        , defaults = []
+                        , symtab = []
+                        }
+                    )
+                ]
+            , srcref = Just
+                ( SrcRef
+                    { url = "test/Spec"
+                    , short = "test/Spec"
+                    , srcrow = 1
+                    , srccol = 1
+                    , version = Nothing
+                    }
+                )
+            , defaults = []
+            , symtab = []
+            }
+        )
+    )
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/renamer/id-func.expected b/lib/haskell/natural4/test/testdata/golden/renamer/id-func.expected
new file mode 100644
index 000000000..09369fbec
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/renamer/id-func.expected
@@ -0,0 +1,83 @@
+Right
+    ( Hornlike
+        ( RnHornlike
+            { name =
+                [ RnExprName
+                    ( RnName
+                        { rnOccName = MTT "id" :| []
+                        , rnUniqueId = 1
+                        , rnNameType = RnFunction
+                        }
+                    )
+                , RnExprName
+                    ( RnName
+                        { rnOccName = MTT "x" :| []
+                        , rnUniqueId = 0
+                        , rnNameType = RnVariable
+                        }
+                    )
+                ]
+            , super = Nothing
+            , keyword = Decide
+            , given = Just
+                ( RnParamText
+                    { mkParamText = RnTypedMulti
+                        { rnTypedMultiExpr = RnExprName
+                            ( RnName
+                                { rnOccName = MTT "x" :| []
+                                , rnUniqueId = 0
+                                , rnNameType = RnVariable
+                                }
+                            ) :| []
+                        , rnTypedMultiTypeSig = Nothing
+                        } :| []
+                    }
+                )
+            , giveth = Nothing
+            , upon = Nothing
+            , clauses =
+                [ RnHornClause
+                    { rnHcHead = RnConstraint
+                        [ RnExprName
+                            ( RnName
+                                { rnOccName = MTT "id" :| []
+                                , rnUniqueId = 1
+                                , rnNameType = RnFunction
+                                }
+                            )
+                        , RnExprName
+                            ( RnName
+                                { rnOccName = MTT "x" :| []
+                                , rnUniqueId = 0
+                                , rnNameType = RnVariable
+                                }
+                            )
+                        ] RPis
+                        [ RnExprName
+                            ( RnName
+                                { rnOccName = MTT "x" :| []
+                                , rnUniqueId = 0
+                                , rnNameType = RnVariable
+                                }
+                            )
+                        ]
+                    , rnHcBody = Nothing
+                    }
+                ]
+            , rlabel = Nothing
+            , lsource = Nothing
+            , wwhere = []
+            , srcref = Just
+                ( SrcRef
+                    { url = "test/Spec"
+                    , short = "test/Spec"
+                    , srcrow = 1
+                    , srccol = 1
+                    , version = Nothing
+                    }
+                )
+            , defaults = []
+            , symtab = []
+            }
+        )
+    )
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/bookWithAttributes.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/bookWithAttributes.expected
new file mode 100644
index 000000000..72533e21d
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/bookWithAttributes.expected
@@ -0,0 +1,2 @@
+let f_g_4 = fun( v_d_0 ) => let v_y_1 =
+    { s_book_2 = if v_d_0 > 0 then 'green else if b_OTHERWISE_3 then 'red else undefined } in v_y_1
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/id.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/id.expected
new file mode 100644
index 000000000..40f7ef981
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/id.expected
@@ -0,0 +1 @@
+let f_id_1 = fun( v_x_0 ) => v_x_0
\ No newline at end of file

From 00b96225521dbe097704a0d6356959422a7d4194 Mon Sep 17 00:00:00 2001
From: Andres Loeh <andres@well-typed.com>
Date: Wed, 7 Aug 2024 14:00:36 +0200
Subject: [PATCH 13/44] Comments and small modifications in renamer.

---
 lib/haskell/natural4/src/LS/Renamer.hs | 128 ++++++++++++++++---------
 1 file changed, 85 insertions(+), 43 deletions(-)

diff --git a/lib/haskell/natural4/src/LS/Renamer.hs b/lib/haskell/natural4/src/LS/Renamer.hs
index 4357520d5..ec45366fc 100644
--- a/lib/haskell/natural4/src/LS/Renamer.hs
+++ b/lib/haskell/natural4/src/LS/Renamer.hs
@@ -19,7 +19,6 @@ import LS.Types qualified as LS
 
 import Control.Monad.Error.Class
 import Control.Monad.Extra (foldM, fromMaybeM)
-import Control.Monad.State.Class qualified as State
 import Control.Monad.State.Strict (MonadState)
 import Control.Monad.Trans.Except (ExceptT)
 import Control.Monad.Trans.Except qualified as Except
@@ -48,6 +47,7 @@ data RnRule
 
 type RnBoolStructR = AA.OptionallyLabeledBoolStruct RnRelationalPredicate
 
+-- | Corresponds to 'HornClause2', which is equivalent to @HornClause BoolStructR@.
 data RnHornClause = RnHornClause
   { rnHcHead :: RnRelationalPredicate
   , rnHcBody :: Maybe RnBoolStructR
@@ -141,6 +141,8 @@ newtype Renamer a = Renamer {runRenamer :: ExceptT String (State Scope) a}
   deriving newtype (MonadState Scope, MonadError String)
 
 type Unique = Int
+
+-- | An unresolved name as it occurs in the original source.
 type OccName = NonEmpty LS.MTExpr
 
 data FuncInfo = FuncInfo
@@ -158,7 +160,7 @@ mkSimpleOccName = NE.singleton . LS.MTT
 
 data Scope = Scope
   { _scScopeTable :: ScopeTable
-  , _scUnique :: Unique
+  , _scUnique :: Unique -- ^ next unique value that we can use
   }
   deriving (Eq, Ord, Show)
 
@@ -169,9 +171,14 @@ data BindingScope
   | GivethScope
   deriving (Eq, Ord, Show)
 
+-- | Invariant:
+--
+-- Every name that gets resolved to an 'RnName' with 'RnNameType' being
+-- 'RnFunction' should have additional 'FuncInfo' in '_stFunction'.
+--
 data ScopeTable = ScopeTable
-  { _stVariables :: Map OccName RnName
-  , _stFunction :: Map RnName FuncInfo
+  { _stVariables :: Map OccName RnName -- ^ all names currently in scope
+  , _stFunction :: Map RnName FuncInfo -- ^ additional information for resolved functions
   }
   deriving (Eq, Ord, Show)
 
@@ -194,17 +201,21 @@ prefixScope = undefined
 
 newUniqueM :: Renamer Unique
 newUniqueM = do
-  u <- State.gets _scUnique
-  State.modify' (\s -> s & scUnique %~ (+ 1))
+  u <- use scUnique
+  modifying' scUnique (+ 1)
   pure u
 
 lookupName :: OccName -> Renamer (Maybe RnName)
-lookupName occName = do
-  st <- State.gets _scScopeTable
-  pure $ Map.lookup occName (_stVariables st)
+lookupName occName =
+  use (scScopeTable % stVariables % at occName)
 
+-- | Either inserts a new name of the given type, or checks that the name
+-- is already in scope with the given type.
+--
+-- Fails if the name type does not match.
+--
 lookupOrInsertName :: OccName -> RnNameType -> Renamer RnName
-lookupOrInsertName occName nameType = do
+lookupOrInsertName occName nameType =
   lookupName occName >>= \case
     Nothing -> insertName occName nameType
     Just name
@@ -226,27 +237,24 @@ insertName occName nameType = do
         , rnOccName = occName
         , rnNameType = nameType
         }
-  State.modify' $ \(s :: Scope) ->
-    s
-      & scScopeTable
-      % stVariables
-      % at occName
-      .~ Just rnName
+  assign'
+    ( scScopeTable
+    % stVariables
+    % at occName
+    ) (Just rnName)
   pure rnName
 
 insertFunction :: RnName -> FuncInfo -> Renamer ()
-insertFunction rnFnName funcInfo = do
-  State.modify' $ \s ->
-    s
-      & scScopeTable
-      % stFunction
-      % at rnFnName
-      .~ Just funcInfo
+insertFunction rnFnName funcInfo =
+  assign'
+    ( scScopeTable
+    % stFunction
+    % at rnFnName
+    ) (Just funcInfo)
 
 lookupFunction :: RnName -> Renamer (Maybe FuncInfo)
 lookupFunction rnFnName =
-  State.gets $ \s ->
-    s ^. scScopeTable % stFunction % at rnFnName
+  use (scScopeTable % stFunction % at rnFnName)
 
 -- ----------------------------------------------------------------------------
 -- Helper types for local context
@@ -355,17 +363,19 @@ renameGivens ::
   Renamer (Maybe RnParamText)
 renameGivens Nothing = pure Nothing
 renameGivens (Just givens) = do
-  rnGivens <- mapM renameGiven givens
+  rnGivens <- traverse renameGiven givens
   pure $ Just $ RnParamText rnGivens
- where
-  renameGiven (mtExprs, typeSig) = do
-    rnMtExprs <- renameGivenMultiTerm mtExprs
-    rnTypeSig <- traverse renameTypeSignature typeSig
-    pure $ RnTypedMulti (NE.singleton $ RnExprName rnMtExprs) rnTypeSig
-
-  renameGivenMultiTerm mtExprs = do
-    mt <- assertSingletonMultiTerm mtExprs
-    insertName (pure mt) RnVariable
+ 
+renameGiven :: LS.TypedMulti -> Renamer RnTypedMulti
+renameGiven (mtExprs, typeSig) = do
+  rnMtExprs <- renameGivenMultiTerm mtExprs
+  rnTypeSig <- traverse renameTypeSignature typeSig
+  pure $ RnTypedMulti (NE.singleton $ RnExprName rnMtExprs) rnTypeSig
+
+renameGivenMultiTerm :: NonEmpty LS.MTExpr -> Renamer RnName
+renameGivenMultiTerm mtExprs = do
+  mt <- assertSingletonMultiTerm mtExprs
+  insertName (pure mt) RnVariable
 
 renameTypeSignature ::
   LS.TypeSig ->
@@ -383,9 +393,9 @@ renameTypeSignature sig = case sig of
  where
   renameEntityType :: LS.EntityType -> Renamer RnEntityType
   renameEntityType eType =
-    -- This is might be a new entity type. However, we allow ad-hoc type definitions.
-    -- Thus, insert a new entity type. This definition defines one name for all
-    -- 'EntityType's with the same name over the whole program.
+    -- This can either refer to an existing entity type, or define a new,
+    -- ad-hoc, entity type. We just assume that multiple ad-hoc definitions
+    -- of the same name in the same scope must be consistent.
     lookupOrInsertName (mkSimpleOccName eType) RnType
 
   -- Why not reuse 'renameGivens'? It is basically the same type!
@@ -410,12 +420,16 @@ renameTypeSignature sig = case sig of
   -- TODO: We reuse this for Type declarations as well, are nested type signatures allowed in this case?
   -- Even in that case, since 'TypeDecl''s 'has' is a list of 'TypeDecl''s, it seems like
   -- there is no arbitrary nesting.
+  --
+  -- ANDRES: I think the fact that type signatures allow nested
+  -- type signatures is a shortcoming of the input syntax that should
+  -- be fixed at that level.
   renameGivenInlineEnumParamText :: LS.ParamText -> Renamer RnParamText
   renameGivenInlineEnumParamText params = do
     let
       renameEach tm = do
         mt <- assertNoTypeSignature tm
-        _t <- assertMultiExprIsOnlyText mt
+        _t <- assertMultiExprIsOnlyText mt -- unclear if we really want this
         enumName <- insertName mt RnEnum
         pure $
           RnTypedMulti
@@ -423,7 +437,7 @@ renameTypeSignature sig = case sig of
             , rnTypedMultiTypeSig = Nothing
             }
 
-    rnParams <- mapM renameEach params
+    rnParams <- traverse renameEach params
     pure $ RnParamText rnParams
 
 renameHornClause :: LS.HornClause2 -> Renamer RnHornClause
@@ -436,6 +450,14 @@ renameHornClause hc = do
       , rnHcBody = rnBody
       }
 
+-- Special renaming function for the relational predicates that occur in
+-- the head of @DECIDE clauses@, e.g. @DECIDE foo IS bar@.
+--
+-- We detect the occurrence of @IS@ and treat it in a special way,
+-- and in the case of a multi-term, we use 'renameDecideMultiTerm'
+-- which allows the *introduction* of variables rather than just referencing
+-- them.
+--
 renameDecideHeadClause :: LS.RelationalPredicate -> Renamer RnRelationalPredicate
 renameDecideHeadClause = \case
   LS.RPParamText pText -> throwError $ "Received 'RPParamText', we can't handle that yet. Got: " <> show pText
@@ -485,13 +507,27 @@ renameDecideHeadClause = \case
 -- Note, this doesn't accept literals such as '42' or '3.5f'.
 renameDecideMultiTerm :: LS.MultiTerm -> Renamer RnMultiTerm
 renameDecideMultiTerm mt = do
-  scopeTable <- State.gets _scScopeTable
+  scopeTable <- use scScopeTable
   case mt of
     attrs
       | Just (obj, objAttrs) <- toObjectPath attrs -> do
+          -- DECIDE x IS ...
+          -- DECIDE x's y's z IS ...
           rnName <- lookupOrInsertName (mkSimpleOccName obj) RnVariable
           rnObjAttrs <- mapM (\attr -> RnExprName <$> lookupOrInsertName (mkSimpleOccName attr) RnSelector) objAttrs
           pure $ RnExprName rnName : rnObjAttrs
+
+    -- ANDRES: I think we should generalise this to something like
+    -- the following:
+    --
+    -- If we have a list of names x_1, x_2, ... x_n, check if
+    -- there is an x_i such that all x_j with i /= j are known
+    -- (givens), and x_i is either unknown, or already known as
+    -- a function.
+    --
+    -- I'm not completely sure if this is enough, because we probably
+    -- should be more precise about shadowing existing functions ...
+    --
     [LS.MTT f, LS.MTT x]
       | Just [rnX] <- variableAndFunction scopeTable [x] f -> do
           rnF <- lookupOrInsertName (mkSimpleOccName f) RnFunction
@@ -519,6 +555,9 @@ renameDecideMultiTerm mt = do
 --
 -- It might be, if all the variables are already bound, and the function name
 -- is unbound or already known as a function.
+--
+-- ANDRES: It surprises me that we do not have to check whether
+-- the arity matches.
 variableAndFunction :: ScopeTable -> [Text] -> Text -> Maybe [RnName]
 variableAndFunction st variables function = do
   -- TODO: this is wrong, only consider arguments in the GIVEN's, otherwise
@@ -527,8 +566,8 @@ variableAndFunction st variables function = do
   -- @
   -- GIVEN x DECIDE f x y IS SUM(x, y) WHERE y IS 5
   -- @
-  rnBoundVariables <- traverse ((`Map.lookup` _stVariables st) . mkSimpleOccName) variables
-  case mkSimpleOccName function `Map.lookup` _stVariables st of
+  rnBoundVariables <- traverse ((`Map.lookup` st._stVariables) . mkSimpleOccName) variables
+  case mkSimpleOccName function `Map.lookup` st._stVariables of
     -- The function name must be either unbound, or
     -- registered as a function.
     Just fnName
@@ -598,6 +637,9 @@ renameMultiTermExpression ctx = \case
           | Just literal <- isTextLiteral name ->
               pure (RnExprLit $ RnString literal, notInSelectorContext ctx)
           | isL4BuiltIn name -> do
+              -- ANDRES: I'm not convinced that built-ins should be renamed, and
+              -- if we already detected that they're built-ins, perhaps we should
+              -- just use a different dedicated constructor for this case.
               rnName <- RnExprName <$> rnL4Builtin name
               pure (rnName, notInSelectorContext ctx)
           | ctx ^. multiTermContextInSelector -> do

From 4f0a296b4b1adae877a0978967f3d5dcc792ebd9 Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Thu, 8 Aug 2024 11:17:40 +0200
Subject: [PATCH 14/44] Add TypeDecl renaming phase

---
 lib/haskell/natural4/src/LS/Renamer.hs | 184 ++++++++++++++++---------
 1 file changed, 122 insertions(+), 62 deletions(-)

diff --git a/lib/haskell/natural4/src/LS/Renamer.hs b/lib/haskell/natural4/src/LS/Renamer.hs
index ec45366fc..08f75d64a 100644
--- a/lib/haskell/natural4/src/LS/Renamer.hs
+++ b/lib/haskell/natural4/src/LS/Renamer.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedRecordDot #-}
@@ -24,6 +25,7 @@ import Control.Monad.Trans.Except (ExceptT)
 import Control.Monad.Trans.Except qualified as Except
 import Control.Monad.Trans.State.Strict (State)
 import Control.Monad.Trans.State.Strict qualified as State (runState)
+import Data.Foldable qualified as Foldable
 import Data.List.NonEmpty (NonEmpty)
 import Data.List.NonEmpty qualified as NE
 import Data.Map.Strict (Map)
@@ -33,7 +35,7 @@ import Data.Text (Text)
 import Data.Text qualified as Text
 import Data.Text.Lazy.IO qualified as TL
 import GHC.Generics (Generic)
-import Optics
+import Optics hiding (has)
 import Text.Pretty.Simple qualified as Pretty
 
 -- ----------------------------------------------------------------------------
@@ -43,6 +45,7 @@ import Text.Pretty.Simple qualified as Pretty
 -- | A rename rule is the same as a 'Rule' but
 data RnRule
   = Hornlike RnHornlike
+  | TypeDecl RnTypeDecl
   deriving (Eq, Ord, Show, Generic)
 
 type RnBoolStructR = AA.OptionallyLabeledBoolStruct RnRelationalPredicate
@@ -55,6 +58,7 @@ data RnHornClause = RnHornClause
   deriving (Eq, Ord, Show, Generic)
 
 type RnRuleName = RnMultiTerm
+type RnEntityType = RnName
 
 data RnHornlike = RnHornlike
   { name :: RnRuleName -- MyInstance
@@ -73,7 +77,20 @@ data RnHornlike = RnHornlike
   }
   deriving (Eq, Ord, Show, Generic)
 
-type RnEntityType = RnName
+data RnTypeDecl = RnTypeDecl
+  { name :: RnRuleName -- MyInstance
+  , super :: Maybe RnTypeSig -- IS A Superclass
+  , has :: [RnRule] -- HAS foo :: List Hand, bar :: Optional Restaurant
+  , enums :: Maybe RnParamText -- ONE OF rock, paper, scissors (basically, disjoint subtypes)
+  , given :: Maybe RnParamText
+  , upon :: Maybe RnParamText
+  , rlabel :: Maybe RuleLabel
+  , lsource :: Maybe Text.Text
+  , srcref :: Maybe SrcRef
+  , defaults :: [RnRelationalPredicate] -- SomeConstant IS 500 ; MentalCapacity TYPICALLY True
+  , symtab :: [RnRelationalPredicate] -- SomeConstant IS 500 ; MentalCapacity TYPICALLY True
+  }
+  deriving (Eq, Ord, Show, Generic)
 
 data RnTypeSig
   = RnSimpleType LS.ParamType RnEntityType
@@ -160,7 +177,8 @@ mkSimpleOccName = NE.singleton . LS.MTT
 
 data Scope = Scope
   { _scScopeTable :: ScopeTable
-  , _scUnique :: Unique -- ^ next unique value that we can use
+  , _scUnique :: Unique
+  -- ^ next unique value that we can use
   }
   deriving (Eq, Ord, Show)
 
@@ -171,14 +189,18 @@ data BindingScope
   | GivethScope
   deriving (Eq, Ord, Show)
 
--- | Invariant:
+-- | A 'ScopeTable' keeps tab on the variables and functions that occur in a
+-- program.
+--
+-- Invariant:
 --
 -- Every name that gets resolved to an 'RnName' with 'RnNameType' being
 -- 'RnFunction' should have additional 'FuncInfo' in '_stFunction'.
---
 data ScopeTable = ScopeTable
-  { _stVariables :: Map OccName RnName -- ^ all names currently in scope
-  , _stFunction :: Map RnName FuncInfo -- ^ additional information for resolved functions
+  { _stVariables :: Map OccName RnName
+  -- ^ all names currently in scope
+  , _stFunction :: Map RnName FuncInfo
+  -- ^ additional information for resolved functions
   }
   deriving (Eq, Ord, Show)
 
@@ -213,7 +235,6 @@ lookupName occName =
 -- is already in scope with the given type.
 --
 -- Fails if the name type does not match.
---
 lookupOrInsertName :: OccName -> RnNameType -> Renamer RnName
 lookupOrInsertName occName nameType =
   lookupName occName >>= \case
@@ -239,18 +260,20 @@ insertName occName nameType = do
         }
   assign'
     ( scScopeTable
-    % stVariables
-    % at occName
-    ) (Just rnName)
+        % stVariables
+        % at occName
+    )
+    (Just rnName)
   pure rnName
 
 insertFunction :: RnName -> FuncInfo -> Renamer ()
 insertFunction rnFnName funcInfo =
   assign'
     ( scScopeTable
-    % stFunction
-    % at rnFnName
-    ) (Just funcInfo)
+        % stFunction
+        % at rnFnName
+    )
+    (Just funcInfo)
 
 lookupFunction :: RnName -> Renamer (Maybe FuncInfo)
 lookupFunction rnFnName =
@@ -312,7 +335,7 @@ renameRule rule@Rule.Hornlike{} = do
   super <- traverse renameTypeSignature rule.super
   given <- renameGivens rule.given
   giveth <- renameGiveths rule.giveth
-  upons <- renameUpons rule.upon
+  upon <- renameUpons rule.upon
   wwhere <- traverse renameRule rule.wwhere
   defaults <- assertEmptyList rule.defaults
   symtab <- assertEmptyList rule.symtab
@@ -326,7 +349,7 @@ renameRule rule@Rule.Hornlike{} = do
         , keyword = rule.keyword
         , given = given
         , giveth = giveth
-        , upon = upons
+        , upon = upon
         , clauses = clauses
         , rlabel = rule.rlabel
         , lsource = rule.lsource
@@ -337,7 +360,30 @@ renameRule rule@Rule.Hornlike{} = do
         }
 renameRule r@Rule.Regulative{} = throwError $ "Unsupported rule: " <> show r
 renameRule r@Rule.Constitutive{} = throwError $ "Unsupported rule: " <> show r
-renameRule r@Rule.TypeDecl{} = throwError $ "Unsupported rule: " <> show r
+renameRule rule@Rule.TypeDecl{} = do
+  super <- traverse renameTypeSignature rule.super
+  defaults <- assertEmptyList rule.defaults
+  enums <- renameEnums rule.enums
+  given <- renameGivens rule.given
+  upon <- renameUpons rule.upon
+  symtab <- assertEmptyList rule.symtab
+  has <- traverse renameRule rule.has
+  name <- renameTypeDeclName rule.name
+  pure $
+    TypeDecl
+      RnTypeDecl
+        { name
+        , super
+        , has
+        , enums
+        , given
+        , upon
+        , rlabel = rule.rlabel
+        , lsource = rule.lsource
+        , srcref = rule.srcref
+        , defaults
+        , symtab
+        }
 renameRule r@Rule.Scenario{} = throwError $ "Unsupported rule: " <> show r
 renameRule r@Rule.DefNameAlias{} = throwError $ "Unsupported rule: " <> show r
 renameRule r@Rule.DefTypically{} = throwError $ "Unsupported rule: " <> show r
@@ -347,6 +393,12 @@ renameRule r@Rule.RegFulfilled{} = throwError $ "Unsupported rule: " <> show r
 renameRule r@Rule.RegBreach{} = throwError $ "Unsupported rule: " <> show r
 renameRule r@Rule.NotARule{} = throwError $ "Unsupported rule: " <> show r
 
+renameTypeDeclName :: RuleName -> Renamer RnRuleName
+renameTypeDeclName mtexprs = do
+  mt <- assertSingletonMultiTerm mtexprs
+  rnTyName <- insertName (NE.singleton mt) RnType
+  pure [RnExprName rnTyName]
+
 renameUpons ::
   Maybe LS.ParamText ->
   Renamer (Maybe RnParamText)
@@ -358,6 +410,11 @@ renameGiveths ::
   Renamer (Maybe RnParamText)
 renameGiveths = renameGivens
 
+renameEnums ::
+  Maybe LS.ParamText ->
+  Renamer (Maybe RnParamText)
+renameEnums = traverse renameGivenInlineEnumParamText
+
 renameGivens ::
   Maybe LS.ParamText ->
   Renamer (Maybe RnParamText)
@@ -365,7 +422,7 @@ renameGivens Nothing = pure Nothing
 renameGivens (Just givens) = do
   rnGivens <- traverse renameGiven givens
   pure $ Just $ RnParamText rnGivens
- 
+
 renameGiven :: LS.TypedMulti -> Renamer RnTypedMulti
 renameGiven (mtExprs, typeSig) = do
   rnMtExprs <- renameGivenMultiTerm mtExprs
@@ -398,47 +455,49 @@ renameTypeSignature sig = case sig of
     -- of the same name in the same scope must be consistent.
     lookupOrInsertName (mkSimpleOccName eType) RnType
 
-  -- Why not reuse 'renameGivens'? It is basically the same type!
-  -- Well, we don't handle arbitrary nested type signatures.
-  -- In fact, it is a bit dubious we have them at all!
-  -- The following seems to be possible in theory:
-  --
-  -- @
-  -- GIVEN x IS ONE OF foo IS ONE OF foobar, foobaz
-  -- @
-  --
-  -- What would that suppose to mean? So, for now, we only allow enum definitions
-  -- to be of the following form:
-  --
-  -- @
-  -- GIVEN x IS ONE OF foo, bar, foo baz
-  -- @
-  --
-  -- This means 'x' is one of three possible enum values 'foo', 'bar'
-  -- and 'foo baz'.
-  --
-  -- TODO: We reuse this for Type declarations as well, are nested type signatures allowed in this case?
-  -- Even in that case, since 'TypeDecl''s 'has' is a list of 'TypeDecl''s, it seems like
-  -- there is no arbitrary nesting.
-  --
-  -- ANDRES: I think the fact that type signatures allow nested
-  -- type signatures is a shortcoming of the input syntax that should
-  -- be fixed at that level.
-  renameGivenInlineEnumParamText :: LS.ParamText -> Renamer RnParamText
-  renameGivenInlineEnumParamText params = do
-    let
-      renameEach tm = do
-        mt <- assertNoTypeSignature tm
-        _t <- assertMultiExprIsOnlyText mt -- unclear if we really want this
-        enumName <- insertName mt RnEnum
-        pure $
-          RnTypedMulti
-            { rnTypedMultiExpr = NE.singleton $ RnExprName enumName
-            , rnTypedMultiTypeSig = Nothing
-            }
-
-    rnParams <- traverse renameEach params
-    pure $ RnParamText rnParams
+-- | Rename an enum definition.
+--
+-- Why not reuse 'renameGivens'? It is basically the same type!
+-- Well, we don't handle arbitrary nested type signatures.
+-- In fact, it is a bit dubious we have them at all!
+-- The following seems to be possible in theory:
+--
+-- @
+-- GIVEN x IS ONE OF foo IS ONE OF foobar, foobaz
+-- @
+--
+-- What would that suppose to mean? So, for now, we only allow enum definitions
+-- to be of the following form:
+--
+-- @
+-- GIVEN x IS ONE OF foo, bar, foo baz
+-- @
+--
+-- This means 'x' is one of three possible enum values 'foo', 'bar'
+-- and 'foo baz'.
+--
+-- TODO: We reuse this for Type declarations as well, are nested type signatures allowed in this case?
+-- Even in that case, since 'TypeDecl''s 'has' is a list of 'TypeDecl''s, it seems like
+-- there is no arbitrary nesting.
+--
+-- ANDRES: I think the fact that type signatures allow nested
+-- type signatures is a shortcoming of the input syntax that should
+-- be fixed at that level.
+renameGivenInlineEnumParamText :: LS.ParamText -> Renamer RnParamText
+renameGivenInlineEnumParamText params = do
+  let
+    renameEach tm = do
+      mt <- assertNoTypeSignature tm
+      _t <- assertMultiExprIsOnlyText mt -- unclear if we really want this
+      enumNames <- traverse (\t -> insertName (NE.singleton t) RnEnum) mt
+      pure $
+        RnTypedMulti
+          { rnTypedMultiExpr = fmap RnExprName enumNames
+          , rnTypedMultiTypeSig = Nothing
+          }
+
+  rnParams <- traverse renameEach params
+  pure $ RnParamText rnParams
 
 renameHornClause :: LS.HornClause2 -> Renamer RnHornClause
 renameHornClause hc = do
@@ -707,9 +766,10 @@ assertMultiExprIsOnlyText mtt = do
   xs <- traverse assertExprIsText mtt
   pure $ Text.unwords $ NE.toList xs
 
-assertSingletonMultiTerm :: NonEmpty LS.MTExpr -> Renamer LS.MTExpr
-assertSingletonMultiTerm (x NE.:| []) = pure x
-assertSingletonMultiTerm xs = throwError $ "Expected singleton but got: " <> show xs
+assertSingletonMultiTerm :: (Show (f LS.MTExpr), Foldable f) => f LS.MTExpr -> Renamer LS.MTExpr
+assertSingletonMultiTerm xs = case Foldable.toList xs of
+  [x] -> pure x
+  _ -> throwError $ "Expected singleton but got: " <> show xs
 
 assertMultiExprIsText :: NonEmpty LS.MTExpr -> Renamer Text
 assertMultiExprIsText mts = do

From 2141b743bcff17289156d91fb22cd7f4e3d7746e Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Fri, 9 Aug 2024 11:38:34 +0200
Subject: [PATCH 15/44] Add Trie implementation to implement lexical scope
 checking

This was an attempt to use Tries for lexical scope checking. However,
after talking a little bit more about this, we decided to change this a
simpler implementation.
---
 lib/haskell/natural4/src/LS/Renamer.hs | 182 +++++++++++++++++++++----
 1 file changed, 156 insertions(+), 26 deletions(-)

diff --git a/lib/haskell/natural4/src/LS/Renamer.hs b/lib/haskell/natural4/src/LS/Renamer.hs
index 08f75d64a..d240bce94 100644
--- a/lib/haskell/natural4/src/LS/Renamer.hs
+++ b/lib/haskell/natural4/src/LS/Renamer.hs
@@ -8,10 +8,13 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
 {-# OPTIONS_GHC -Wall #-}
 
 module LS.Renamer where
 
+import Prelude hiding (lookup)
+
 import AnyAll.BoolStruct qualified as AA
 import LS.Rule (Rule, RuleLabel)
 import LS.Rule qualified as Rule
@@ -21,20 +24,23 @@ import LS.Types qualified as LS
 import Control.Monad.Error.Class
 import Control.Monad.Extra (foldM, fromMaybeM)
 import Control.Monad.State.Strict (MonadState)
+import Control.Monad.State.Strict qualified as State
 import Control.Monad.Trans.Except (ExceptT)
 import Control.Monad.Trans.Except qualified as Except
 import Control.Monad.Trans.State.Strict (State)
-import Control.Monad.Trans.State.Strict qualified as State (runState)
+import Control.Monad.Trans.State.Strict qualified as State (runStateT)
 import Data.Foldable qualified as Foldable
 import Data.List.NonEmpty (NonEmpty)
 import Data.List.NonEmpty qualified as NE
 import Data.Map.Strict (Map)
 import Data.Map.Strict qualified as Map
+import Data.Maybe (fromMaybe)
 import Data.Set qualified as Set
 import Data.Text (Text)
 import Data.Text qualified as Text
 import Data.Text.Lazy.IO qualified as TL
 import GHC.Generics (Generic)
+import GHC.List qualified as List
 import Optics hiding (has)
 import Text.Pretty.Simple qualified as Pretty
 
@@ -58,6 +64,8 @@ data RnHornClause = RnHornClause
   deriving (Eq, Ord, Show, Generic)
 
 type RnRuleName = RnMultiTerm
+type RnFullRuleName = [RnRuleOccName]
+type RnRuleOccName = [Text]
 type RnEntityType = RnName
 
 data RnHornlike = RnHornlike
@@ -111,6 +119,7 @@ data RnTypedMulti = RnTypedMulti
 -- | A name is something that can be resolved as either a variable, function, or enum.
 data RnName = RnName
   { rnOccName :: OccName
+  , rnRuleOccName :: RnFullRuleName
   , rnUniqueId :: Unique
   , rnNameType :: RnNameType
   -- TODO: add the binding scope for scope checking
@@ -149,6 +158,76 @@ data RnRelationalPredicate
   | RnNary LS.RPRel [RnRelationalPredicate]
   deriving (Eq, Ord, Show, Generic)
 
+-- ----------------------------------------------------------------------------
+-- Utility data structures. To be moved outside of this module. Perhaps use
+-- third-party library?
+-- ----------------------------------------------------------------------------
+
+-- rename (Let decls expr) = do { ns <- scanNames decls; rdecls <- withExtendedScope ns (traverse renameDecl decls); rexpr <- withExtendedScope ns (renameExpr expr); pure (RLet rdecls rexpr) }
+
+data Trie k v = Trie
+  { _trieValue :: !(Maybe v)
+  , _trieChildren :: !(Map k (Trie k v))
+  }
+  deriving (Eq, Ord, Foldable, Functor, Show, Traversable)
+
+empty :: Trie k v
+empty = Trie Nothing Map.empty
+
+singleton :: (Eq k) => [k] -> v -> Trie k v
+singleton [] x = Trie (Just x) Map.empty
+singleton (k : ks) x = Trie Nothing (Map.singleton k (singleton ks x))
+
+unionWith ::
+  (Eq k, Ord k) =>
+  (v -> v -> v) ->
+  Trie k v ->
+  Trie k v ->
+  Trie k v
+unionWith f (Trie v1 c1) (Trie v2 c2) =
+  Trie v $ Map.unionWith (unionWith f) c1 c2
+ where
+  v = case (v1, v2) of
+    (Nothing, _) -> v2
+    (_, Nothing) -> v1
+    (Just x, Just y) -> Just (f x y)
+
+unionsWith ::
+  (Eq k, Ord k) =>
+  (v -> v -> v) ->
+  [Trie k v] ->
+  Trie k v
+unionsWith f = List.foldl' (unionWith f) empty
+
+prefix :: (Eq k, Ord k) => [k] -> Trie k v -> Trie k v
+prefix [] trie = trie
+prefix (k : ks) trie = Trie Nothing $ Map.singleton k (prefix ks trie)
+
+lookup :: (Eq k, Ord k) => [k] -> Trie k v -> Maybe v
+lookup [] (Trie Nothing _) = Nothing
+lookup [] (Trie (Just x) _) = Just x
+lookup (k : ks) (Trie _ children) = do
+  trie <- Map.lookup k children
+  lookup ks trie
+
+-- alterF :: Functor f
+--        => (Maybe a -> f (Maybe a)) -> [k] -> Trie k a -> f (Trie k a)
+-- -- This implementation was stolen from 'Control.Lens.At'.
+-- alterF f [] (Trie Nothing _) = Nothing
+-- alterF f [] (Trie (Just x) _) = Just x
+-- alterF f (k : ks) (Trie _ children) = do
+--   trie <- alterF f ks children
+--   lookup ks trie
+
+-- instance Ord k => At (Trie k a) where
+--   at k = lensVL $ \f -> alterF f k
+--   {-# INLINE at #-}
+
+-- type instance Index (Trie k a) = [k]
+-- type instance IxValue (Trie k a) = a
+-- -- Default implementation uses Map.alterF
+-- instance Ord k => Ixed (Trie k a)
+
 -- ----------------------------------------------------------------------------
 -- Scope tables
 -- ----------------------------------------------------------------------------
@@ -176,14 +255,16 @@ mkSimpleOccName :: Text -> OccName
 mkSimpleOccName = NE.singleton . LS.MTT
 
 data Scope = Scope
-  { _scScopeTable :: ScopeTable
+  { _scScopeTable :: Trie RnRuleOccName ScopeTable
   , _scUnique :: Unique
   -- ^ next unique value that we can use
+  , _scBindingScope :: BindingScope
+  , _scRuleOccName :: RnFullRuleName
   }
   deriving (Eq, Ord, Show)
 
 data BindingScope
-  = ToplevelScope
+  = TopLevelScope
   | WhereScope
   | GivenScope
   | GivethScope
@@ -204,18 +285,24 @@ data ScopeTable = ScopeTable
   }
   deriving (Eq, Ord, Show)
 
+emptyScopeTable :: ScopeTable
+emptyScopeTable =
+  ScopeTable
+    { _stVariables = Map.empty
+    , _stFunction = Map.empty
+    }
+
 makeFieldsNoPrefix 'Scope
+makeFields 'Trie
 makeFieldsNoPrefix 'ScopeTable
 
 emptyScope :: Scope
 emptyScope =
   Scope
-    { _scScopeTable =
-        ScopeTable
-          { _stVariables = Map.empty
-          , _stFunction = Map.empty
-          }
+    { _scScopeTable = empty
     , _scUnique = 0
+    , _scBindingScope = TopLevelScope
+    , _scRuleOccName = []
     }
 
 prefixScope :: RuleName -> Scope -> Scope
@@ -228,8 +315,11 @@ newUniqueM = do
   pure u
 
 lookupName :: OccName -> Renamer (Maybe RnName)
-lookupName occName =
-  use (scScopeTable % stVariables % at occName)
+lookupName occName = do
+  ruleOccName <- use scRuleOccName
+  State.gets $ \s -> do
+    (scope :: ScopeTable) <- lookup ruleOccName s._scScopeTable
+    occName `Map.lookup` scope._stVariables
 
 -- | Either inserts a new name of the given type, or checks that the name
 -- is already in scope with the given type.
@@ -251,33 +341,72 @@ lookupOrInsertName occName nameType =
 insertName :: OccName -> RnNameType -> Renamer RnName
 insertName occName nameType = do
   n <- newUniqueM
+  ruleOccName <- use scRuleOccName
   let
     rnName =
       RnName
         { rnUniqueId = n
         , rnOccName = occName
+        , rnRuleOccName = ruleOccName
         , rnNameType = nameType
         }
-  assign'
-    ( scScopeTable
-        % stVariables
-        % at occName
-    )
-    (Just rnName)
+
+  State.modify' $ \s ->
+    let
+      st =
+        unionWith
+          unionScopeTable
+          s._scScopeTable
+          ( singleton ruleOccName $
+              ScopeTable
+                { _stVariables = Map.singleton occName rnName
+                , _stFunction = Map.empty
+                }
+          )
+    in
+      s{_scScopeTable = st}
+
   pure rnName
 
+unionScopeTable :: ScopeTable -> ScopeTable -> ScopeTable
+unionScopeTable sc1 sc2 =
+  ScopeTable
+    { _stVariables =
+        Map.unionWith
+          (\a b -> if a == b then a else error "Invariant unionWith")
+          sc1._stVariables
+          sc2._stVariables
+    , _stFunction =
+        Map.unionWith
+          (\a b -> if a == b then a else error "Invariant unionWith")
+          sc1._stFunction
+          sc2._stFunction
+    }
+
 insertFunction :: RnName -> FuncInfo -> Renamer ()
-insertFunction rnFnName funcInfo =
-  assign'
-    ( scScopeTable
-        % stFunction
-        % at rnFnName
-    )
-    (Just funcInfo)
+insertFunction rnFnName funcInfo = do
+  ruleOccName <- use scRuleOccName
+  State.modify' $ \s ->
+    let
+      st =
+        unionWith
+          const
+          s._scScopeTable
+          ( singleton ruleOccName $
+              ScopeTable
+                { _stVariables = Map.empty
+                , _stFunction = Map.singleton rnFnName funcInfo
+                }
+          )
+    in
+      s{_scScopeTable = st}
 
 lookupFunction :: RnName -> Renamer (Maybe FuncInfo)
-lookupFunction rnFnName =
-  use (scScopeTable % stFunction % at rnFnName)
+lookupFunction rnFnName = do
+  ruleOccName <- use scRuleOccName
+  State.gets $ \s -> do
+    (scope :: ScopeTable) <- lookup ruleOccName s._scScopeTable
+    rnFnName `Map.lookup` scope._stFunction
 
 -- ----------------------------------------------------------------------------
 -- Helper types for local context
@@ -566,7 +695,8 @@ renameDecideHeadClause = \case
 -- Note, this doesn't accept literals such as '42' or '3.5f'.
 renameDecideMultiTerm :: LS.MultiTerm -> Renamer RnMultiTerm
 renameDecideMultiTerm mt = do
-  scopeTable <- use scScopeTable
+  ruleOccName <- use scRuleOccName
+  scopeTable <- (fromMaybe emptyScopeTable . lookup ruleOccName) <$> use scScopeTable
   case mt of
     attrs
       | Just (obj, objAttrs) <- toObjectPath attrs -> do

From cf5e14dbae90a8d3b28cc0b63f97dd87234c18ed Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Fri, 9 Aug 2024 15:58:56 +0200
Subject: [PATCH 16/44] Implement better lexical scoping

Scan the clauses of rules for variables they may have introduced.
Rename in a separate step.
---
 lib/haskell/natural4/src/LS/Renamer.hs        | 713 +++++++++---------
 .../natural4/src/LS/XPile/Simala/Transpile.hs |  10 +-
 2 files changed, 356 insertions(+), 367 deletions(-)

diff --git a/lib/haskell/natural4/src/LS/Renamer.hs b/lib/haskell/natural4/src/LS/Renamer.hs
index d240bce94..b03424838 100644
--- a/lib/haskell/natural4/src/LS/Renamer.hs
+++ b/lib/haskell/natural4/src/LS/Renamer.hs
@@ -8,13 +8,10 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeFamilies #-}
 {-# OPTIONS_GHC -Wall #-}
 
 module LS.Renamer where
 
-import Prelude hiding (lookup)
-
 import AnyAll.BoolStruct qualified as AA
 import LS.Rule (Rule, RuleLabel)
 import LS.Rule qualified as Rule
@@ -24,23 +21,23 @@ import LS.Types qualified as LS
 import Control.Monad.Error.Class
 import Control.Monad.Extra (foldM, fromMaybeM)
 import Control.Monad.State.Strict (MonadState)
-import Control.Monad.State.Strict qualified as State
 import Control.Monad.Trans.Except (ExceptT)
 import Control.Monad.Trans.Except qualified as Except
 import Control.Monad.Trans.State.Strict (State)
-import Control.Monad.Trans.State.Strict qualified as State (runStateT)
+import Control.Monad.Trans.State.Strict qualified as State (runState)
+import Data.Foldable (traverse_)
 import Data.Foldable qualified as Foldable
+import Data.Functor (void)
+import Data.List qualified as List
 import Data.List.NonEmpty (NonEmpty)
 import Data.List.NonEmpty qualified as NE
 import Data.Map.Strict (Map)
 import Data.Map.Strict qualified as Map
-import Data.Maybe (fromMaybe)
 import Data.Set qualified as Set
 import Data.Text (Text)
 import Data.Text qualified as Text
 import Data.Text.Lazy.IO qualified as TL
 import GHC.Generics (Generic)
-import GHC.List qualified as List
 import Optics hiding (has)
 import Text.Pretty.Simple qualified as Pretty
 
@@ -64,8 +61,6 @@ data RnHornClause = RnHornClause
   deriving (Eq, Ord, Show, Generic)
 
 type RnRuleName = RnMultiTerm
-type RnFullRuleName = [RnRuleOccName]
-type RnRuleOccName = [Text]
 type RnEntityType = RnName
 
 data RnHornlike = RnHornlike
@@ -119,7 +114,6 @@ data RnTypedMulti = RnTypedMulti
 -- | A name is something that can be resolved as either a variable, function, or enum.
 data RnName = RnName
   { rnOccName :: OccName
-  , rnRuleOccName :: RnFullRuleName
   , rnUniqueId :: Unique
   , rnNameType :: RnNameType
   -- TODO: add the binding scope for scope checking
@@ -158,76 +152,6 @@ data RnRelationalPredicate
   | RnNary LS.RPRel [RnRelationalPredicate]
   deriving (Eq, Ord, Show, Generic)
 
--- ----------------------------------------------------------------------------
--- Utility data structures. To be moved outside of this module. Perhaps use
--- third-party library?
--- ----------------------------------------------------------------------------
-
--- rename (Let decls expr) = do { ns <- scanNames decls; rdecls <- withExtendedScope ns (traverse renameDecl decls); rexpr <- withExtendedScope ns (renameExpr expr); pure (RLet rdecls rexpr) }
-
-data Trie k v = Trie
-  { _trieValue :: !(Maybe v)
-  , _trieChildren :: !(Map k (Trie k v))
-  }
-  deriving (Eq, Ord, Foldable, Functor, Show, Traversable)
-
-empty :: Trie k v
-empty = Trie Nothing Map.empty
-
-singleton :: (Eq k) => [k] -> v -> Trie k v
-singleton [] x = Trie (Just x) Map.empty
-singleton (k : ks) x = Trie Nothing (Map.singleton k (singleton ks x))
-
-unionWith ::
-  (Eq k, Ord k) =>
-  (v -> v -> v) ->
-  Trie k v ->
-  Trie k v ->
-  Trie k v
-unionWith f (Trie v1 c1) (Trie v2 c2) =
-  Trie v $ Map.unionWith (unionWith f) c1 c2
- where
-  v = case (v1, v2) of
-    (Nothing, _) -> v2
-    (_, Nothing) -> v1
-    (Just x, Just y) -> Just (f x y)
-
-unionsWith ::
-  (Eq k, Ord k) =>
-  (v -> v -> v) ->
-  [Trie k v] ->
-  Trie k v
-unionsWith f = List.foldl' (unionWith f) empty
-
-prefix :: (Eq k, Ord k) => [k] -> Trie k v -> Trie k v
-prefix [] trie = trie
-prefix (k : ks) trie = Trie Nothing $ Map.singleton k (prefix ks trie)
-
-lookup :: (Eq k, Ord k) => [k] -> Trie k v -> Maybe v
-lookup [] (Trie Nothing _) = Nothing
-lookup [] (Trie (Just x) _) = Just x
-lookup (k : ks) (Trie _ children) = do
-  trie <- Map.lookup k children
-  lookup ks trie
-
--- alterF :: Functor f
---        => (Maybe a -> f (Maybe a)) -> [k] -> Trie k a -> f (Trie k a)
--- -- This implementation was stolen from 'Control.Lens.At'.
--- alterF f [] (Trie Nothing _) = Nothing
--- alterF f [] (Trie (Just x) _) = Just x
--- alterF f (k : ks) (Trie _ children) = do
---   trie <- alterF f ks children
---   lookup ks trie
-
--- instance Ord k => At (Trie k a) where
---   at k = lensVL $ \f -> alterF f k
---   {-# INLINE at #-}
-
--- type instance Index (Trie k a) = [k]
--- type instance IxValue (Trie k a) = a
--- -- Default implementation uses Map.alterF
--- instance Ord k => Ixed (Trie k a)
-
 -- ----------------------------------------------------------------------------
 -- Scope tables
 -- ----------------------------------------------------------------------------
@@ -255,16 +179,14 @@ mkSimpleOccName :: Text -> OccName
 mkSimpleOccName = NE.singleton . LS.MTT
 
 data Scope = Scope
-  { _scScopeTable :: Trie RnRuleOccName ScopeTable
-  , _scUnique :: Unique
+  { _scScopeTable :: ScopeTable
+  , _scUniqueSupply :: Unique
   -- ^ next unique value that we can use
-  , _scBindingScope :: BindingScope
-  , _scRuleOccName :: RnFullRuleName
   }
   deriving (Eq, Ord, Show)
 
 data BindingScope
-  = TopLevelScope
+  = ToplevelScope
   | WhereScope
   | GivenScope
   | GivethScope
@@ -285,6 +207,16 @@ data ScopeTable = ScopeTable
   }
   deriving (Eq, Ord, Show)
 
+unionScopeTable :: ScopeTable -> ScopeTable -> ScopeTable
+unionScopeTable tbl1 tbl2 =
+  ScopeTable
+    { _stVariables = Map.union tbl1._stVariables tbl2._stVariables
+    , _stFunction = Map.union tbl1._stFunction tbl2._stFunction
+    }
+
+makeFieldsNoPrefix 'Scope
+makeFieldsNoPrefix 'ScopeTable
+
 emptyScopeTable :: ScopeTable
 emptyScopeTable =
   ScopeTable
@@ -292,34 +224,47 @@ emptyScopeTable =
     , _stFunction = Map.empty
     }
 
-makeFieldsNoPrefix 'Scope
-makeFields 'Trie
-makeFieldsNoPrefix 'ScopeTable
-
 emptyScope :: Scope
 emptyScope =
   Scope
-    { _scScopeTable = empty
-    , _scUnique = 0
-    , _scBindingScope = TopLevelScope
-    , _scRuleOccName = []
+    { _scScopeTable = emptyScopeTable
+    , _scUniqueSupply = 0
     }
 
 prefixScope :: RuleName -> Scope -> Scope
 prefixScope = undefined
 
-newUniqueM :: Renamer Unique
-newUniqueM = do
-  u <- use scUnique
-  modifying' scUnique (+ 1)
+newUnique :: Renamer Unique
+newUnique = do
+  u <- use scUniqueSupply
+  modifying' scUniqueSupply (+ 1)
   pure u
 
+-- | Lookup the given name in the 'ScopeTable'.
 lookupName :: OccName -> Renamer (Maybe RnName)
-lookupName occName = do
-  ruleOccName <- use scRuleOccName
-  State.gets $ \s -> do
-    (scope :: ScopeTable) <- lookup ruleOccName s._scScopeTable
-    occName `Map.lookup` scope._stVariables
+lookupName occName =
+  use (scScopeTable % stVariables % at occName)
+
+-- | Look up the name associated with a given 'OccName' and assert it has
+-- the correct 'RnNameType'.
+--
+-- This can be used when the 'OccName' *must* be present in the 'ScopeTable',
+-- otherwise an assumption has been violated.
+-- If the name cannot be found, or the name is not of the expected type, we
+-- throw an exception.
+lookupExistingName :: OccName -> RnNameType -> Renamer RnName
+lookupExistingName occName nameType = do
+  mRnName <- lookupName occName
+  case mRnName of
+    Nothing -> throwError $ "lookupExistingName: Assumptions violated, name wasn't found: " <> show occName
+    Just name
+      | name.rnNameType == nameType -> pure name
+      | otherwise ->
+          throwError $
+            "lookupExistingName: Invariant violated, trying to insert a different name type for a name that's already known. Got: "
+              <> show nameType
+              <> " but expected: "
+              <> show (rnNameType name)
 
 -- | Either inserts a new name of the given type, or checks that the name
 -- is already in scope with the given type.
@@ -340,73 +285,34 @@ lookupOrInsertName occName nameType =
 
 insertName :: OccName -> RnNameType -> Renamer RnName
 insertName occName nameType = do
-  n <- newUniqueM
-  ruleOccName <- use scRuleOccName
+  n <- newUnique
   let
     rnName =
       RnName
         { rnUniqueId = n
         , rnOccName = occName
-        , rnRuleOccName = ruleOccName
         , rnNameType = nameType
         }
-
-  State.modify' $ \s ->
-    let
-      st =
-        unionWith
-          unionScopeTable
-          s._scScopeTable
-          ( singleton ruleOccName $
-              ScopeTable
-                { _stVariables = Map.singleton occName rnName
-                , _stFunction = Map.empty
-                }
-          )
-    in
-      s{_scScopeTable = st}
-
+  assign'
+    ( scScopeTable
+        % stVariables
+        % at occName
+    )
+    (Just rnName)
   pure rnName
 
-unionScopeTable :: ScopeTable -> ScopeTable -> ScopeTable
-unionScopeTable sc1 sc2 =
-  ScopeTable
-    { _stVariables =
-        Map.unionWith
-          (\a b -> if a == b then a else error "Invariant unionWith")
-          sc1._stVariables
-          sc2._stVariables
-    , _stFunction =
-        Map.unionWith
-          (\a b -> if a == b then a else error "Invariant unionWith")
-          sc1._stFunction
-          sc2._stFunction
-    }
-
 insertFunction :: RnName -> FuncInfo -> Renamer ()
-insertFunction rnFnName funcInfo = do
-  ruleOccName <- use scRuleOccName
-  State.modify' $ \s ->
-    let
-      st =
-        unionWith
-          const
-          s._scScopeTable
-          ( singleton ruleOccName $
-              ScopeTable
-                { _stVariables = Map.empty
-                , _stFunction = Map.singleton rnFnName funcInfo
-                }
-          )
-    in
-      s{_scScopeTable = st}
+insertFunction rnFnName funcInfo =
+  assign'
+    ( scScopeTable
+        % stFunction
+        % at rnFnName
+    )
+    (Just funcInfo)
 
 lookupFunction :: RnName -> Renamer (Maybe FuncInfo)
-lookupFunction rnFnName = do
-  ruleOccName <- use scRuleOccName
-  State.gets $ \s -> do
-    (scope :: ScopeTable) <- lookup ruleOccName s._scScopeTable
-    rnFnName `Map.lookup` scope._stFunction
+lookupFunction rnFnName =
+  use (scScopeTable % stFunction % at rnFnName)
 
 -- ----------------------------------------------------------------------------
 -- Helper types for local context
@@ -420,15 +326,18 @@ data MultiTermContext = MultiTermContext
   -- For example: @[MTT "book's", MTT "title"]@, when @"title"@ is renamed,
   -- the 'multiTermContextInSelector' is set expected to be to 'True', so that
   -- we can infer that @"title"@ is a 'RnSelector'.
+  , _multiTermContextFunctionCall :: Maybe RnName
+  -- ^ During renaming a 'MultiTerm', did we encounter a function application?
+  -- If so, we need to fix the arity!
   }
 
-makeFieldsNoPrefix 'MultiTermContext
+makeFields 'MultiTermContext
 
 inSelectorContext :: MultiTermContext -> MultiTermContext
-inSelectorContext mtc = mtc & multiTermContextInSelector .~ True
+inSelectorContext mtc = mtc & inSelector .~ True
 
 notInSelectorContext :: MultiTermContext -> MultiTermContext
-notInSelectorContext mtc = mtc & multiTermContextInSelector .~ False
+notInSelectorContext mtc = mtc & inSelector .~ False
 
 -- ----------------------------------------------------------------------------
 -- Top Level Definitions
@@ -446,26 +355,261 @@ renameRuleTopLevel rule = do
 
 renameRuleTopLevel' :: Rule -> (Either String RnRule, Scope)
 renameRuleTopLevel' rule =
-  State.runState (Except.runExceptT (runRenamer $ renameRule rule)) emptyScope
+  let
+    (resE, scope) = State.runState (Except.runExceptT (runRenamer $ renamer [rule])) emptyScope
+  in
+    (fmap head resE, scope)
+
+renamer :: [Rule] -> Renamer [RnRule]
+renamer rules = do
+  traverse_ scanRule rules
+  traverse renameRule rules
 
 -- ----------------------------------------------------------------------------
 -- Resolve functions and their respective arities
 -- ----------------------------------------------------------------------------
 
--- fixFunctionFixity :: (MonadState Scope m, MonadError String m) => RnRule -> m RnRule
--- fixFunctionFixity
+-- | Scan the structure of 'Rule' to find declarations that affect other rules.
+--
+-- We identify the following names that can be referenced from other rules:
+--
+-- 1. Functions and variables in the head of 'HornClauses'.
+-- 2. Names declared in 'GIVETH' clauses.
+-- 3. Types and selectors defined via 'DEFINE'
+scanRule :: Rule -> Renamer ()
+scanRule rule@Rule.Hornlike{} = do
+  -- TODO: givens should only be scanned for 'scanHornClause' and then removed again.
+  scanGivens rule.given
+  scanGiveths rule.giveth
+  traverse_ scanHornClause rule.clauses
+scanRule r@Rule.Regulative{} = throwError $ "Unsupported rule: " <> show r
+scanRule r@Rule.Constitutive{} = throwError $ "Unsupported rule: " <> show r
+scanRule rule@Rule.TypeDecl{} = do
+  traverse_ scanTypeSignature rule.super
+  scanEnums rule.enums
+  scanGivens rule.given
+  traverse_ scanRule rule.has
+  scanTypeDeclName rule.name
+scanRule r@Rule.Scenario{} = throwError $ "Unsupported rule: " <> show r
+scanRule r@Rule.DefNameAlias{} = throwError $ "Unsupported rule: " <> show r
+scanRule r@Rule.DefTypically{} = throwError $ "Unsupported rule: " <> show r
+scanRule r@Rule.RuleAlias{} = throwError $ "Unsupported rule: " <> show r
+scanRule r@Rule.RuleGroup{} = throwError $ "Unsupported rule: " <> show r
+scanRule r@Rule.RegFulfilled{} = throwError $ "Unsupported rule: " <> show r
+scanRule r@Rule.RegBreach{} = throwError $ "Unsupported rule: " <> show r
+scanRule r@Rule.NotARule{} = throwError $ "Unsupported rule: " <> show r
+
+-- | Scan a 'LS.HornClause2' for declarations of variables and functions.
+scanHornClause :: LS.HornClause2 -> Renamer ()
+scanHornClause hc = do
+  scanDecideHeadClause hc.hHead
+
+-- | Scan the head of relational predicates that occur in
+-- the head of @DECIDE clauses@, e.g. @DECIDE foo IS bar@.
+--
+-- We detect the occurrence of @IS@ and treat it in a special way,
+-- and in the case of a multi-term, we use 'scanDecideMultiTerm'
+-- which allows the *introduction* of variables.
+scanDecideHeadClause :: LS.RelationalPredicate -> Renamer ()
+scanDecideHeadClause = \case
+  LS.RPParamText pText -> throwError $ "Received 'RPParamText', we can't handle that yet. Got: " <> show pText
+  LS.RPMT mt -> scanDecideMultiTerm mt
+  LS.RPConstraint lhs _predicate _rhs -> do
+    scanDecideMultiTerm lhs
+  LS.RPBoolStructR lhs _predicate _rhs -> do
+    scanDecideMultiTerm lhs
+  LS.RPnary LS.RPis (lhs : _rhs) -> do
+    -- When the assignment has multiple complicated relational predicates,
+    -- it is translated to this 'RPNary'. Then the first element is before the 'IS'
+    -- and the rest after.
+    -- Example:
+    -- @f x IS SUM(x, x, x)@
+    -- is parsed to @RPnary RPis [[f, x], [RPnary RPSum [x, x, x]]]@
+    -- ignoring some details.
+    -- Thus, we scan the first item of 'IS' predicates.
+    scanDecideHeadClause lhs
+  LS.RPnary _predicate _rhs -> do
+    pure ()
+
+-- | Scan a top-level occurrence of 'LS.MultiTerm'.
+--
+-- This is slightly special, as this may be the definition site of functions.
+--
+-- For now, we accept the following 'LS.MultiTerm''s for function definitions:
+--
+-- * @f x1 x2 ...@: function @f@ in prefix with a variable number of parameters @x1, x2, ...@
+-- * @x1 x2 ... f@: function @f@ in postfix with a variable number of parameters @x1, x2, ...@
+-- * @x1 x2 ... f y1 y2 ...@: function @f@ in infix with a variable number of prefix
+--   parameters @x1, x2, ...@ and a variable numbers of postfix parameters @y1 y2 ...@.
+--
+-- Note, to be recognized as a function, variables must have been specified by 'GIVEN'
+-- clauses and the function name must be unbound in its current scope.
+-- TODO: scope checking is currently a WIP.
+--
+-- Additionally, we recognize the following forms:
+--
+-- * @f's x's y's z@: An attribute path from variable @f@ to something that has a @z@ attribute.
+-- * @x@: a variable, might be bound ad-hoc
+--
+-- Note, this doesn't accept literals such as '42' or '3.5f' or True or False.
+scanDecideMultiTerm :: LS.MultiTerm -> Renamer ()
+scanDecideMultiTerm mt = do
+  scopeTable <- use scScopeTable
+  case mt of
+    attrs
+      | Just (obj, objAttrs) <- toObjectPath attrs -> do
+          -- DECIDE x IS ...
+          -- DECIDE x's y's z IS ...
+          _ <- lookupOrInsertName (mkSimpleOccName obj) RnVariable
+          traverse_ (\attr -> RnExprName <$> lookupOrInsertName (mkSimpleOccName attr) RnSelector) objAttrs
+    fnDecl
+      | Just (fnOccName, preArgs, postArgs) <- scanForFunctionDecl scopeTable fnDecl -> do
+          rnF <- lookupOrInsertName fnOccName RnFunction
+          insertFunction rnF (FuncInfo{funcArity = (preArgs, postArgs)})
+    unknownPattern -> throwError $ "While scanning a multi term in a top-level DECIDE clause, we encountered an unsupported pattern: " <> show unknownPattern
+
+-- | Check whether this could be a function like structure.
+--
+-- It might be, if all the variables are already bound, and the function name
+-- is unbound or already known as a function.
+--
+-- ANDRES: It surprises me that we do not have to check whether
+-- the arity matches.
+scanForFunctionDecl :: ScopeTable -> LS.MultiTerm -> Maybe (OccName, Int, Int)
+scanForFunctionDecl scopeTable mts = do
+  let
+    (preVars, fnWithArgs) = List.break (not . isVariable) mts
+  (fnTerm, postVars) <- case fnWithArgs of
+    [] -> Nothing
+    (LS.MTT fnTerm : postTerms) ->
+      if all isVariable postTerms
+        then Just (fnTerm, postTerms)
+        else Nothing
+    _terms -> Nothing
+
+  pure (mkSimpleOccName fnTerm, length preVars, length postVars)
+ where
+  isVariable (LS.MTT x) = case Map.lookup (mkSimpleOccName x) (scopeTable ^. stVariables) of
+    Nothing -> False
+    Just rnName
+      | rnName.rnNameType == RnVariable -> True
+      | otherwise -> False
+  isVariable _ = False
+
+scanGiveths ::
+  Maybe LS.ParamText ->
+  Renamer ()
+scanGiveths = scanGivens
+
+scanEnums ::
+  Maybe LS.ParamText ->
+  Renamer ()
+scanEnums = traverse_ scanGivenInlineEnumParamText
+
+scanGivens ::
+  Maybe LS.ParamText ->
+  Renamer ()
+scanGivens Nothing = pure ()
+scanGivens (Just givens) = do
+  traverse_ scanGiven givens
+
+scanGiven :: LS.TypedMulti -> Renamer ()
+scanGiven (mtExprs, typeSig) = do
+  scanGivenMultiTerm mtExprs
+  traverse_ scanTypeSignature typeSig
+
+scanGivenMultiTerm :: NonEmpty LS.MTExpr -> Renamer ()
+scanGivenMultiTerm mtExprs = do
+  mt <- assertSingletonMultiTerm mtExprs
+  void $ insertName (pure mt) RnVariable
+
+scanTypeSignature ::
+  LS.TypeSig ->
+  Renamer ()
+scanTypeSignature sig = case sig of
+  LS.SimpleType _pType entityType -> do
+    scanEntityType entityType
+  LS.InlineEnum _pType paramText -> do
+    -- TODO: error handling, would we accept an enum such as `a IS ONE OF 1, 2, 3`?
+    -- Only if we treat them as text, which might be confusing, as user might infer
+    -- this to be some kind of type checked number type.
+    scanGivenInlineEnumParamText paramText
+ where
+  scanEntityType :: LS.EntityType -> Renamer ()
+  scanEntityType eType =
+    -- This can either refer to an existing entity type, or define a new,
+    -- ad-hoc, entity type. We just assume that multiple ad-hoc definitions
+    -- of the same name in the same scope must be consistent.
+    void $ lookupOrInsertName (mkSimpleOccName eType) RnType
+
+-- | Scan for names in the enum definition.
+--
+-- Why not reuse 'scanGivens'? It is basically the same type!
+-- Well, we don't handle arbitrary nested type signatures.
+-- In fact, it is a bit dubious we have them at all!
+-- The following seems to be possible in theory:
+--
+-- @
+-- GIVEN x IS ONE OF foo IS ONE OF foobar, foobaz
+-- @
+--
+-- What would that suppose to mean? So, for now, we only allow enum definitions
+-- to be of the following form:
+--
+-- @
+-- GIVEN x IS ONE OF foo, bar, foo baz
+-- @
+--
+-- This means 'x' is one of three possible enum values 'foo', 'bar'
+-- and 'foo baz'.
+--
+-- TODO: We reuse this for Type declarations as well, are nested type signatures allowed in this case?
+-- Even in that case, since 'TypeDecl''s 'has' is a list of 'TypeDecl''s, it seems like
+-- there is no arbitrary nesting.
+--
+-- ANDRES: I think the fact that type signatures allow nested
+-- type signatures is a shortcoming of the input syntax that should
+-- be fixed at that level.
+scanGivenInlineEnumParamText :: LS.ParamText -> Renamer ()
+scanGivenInlineEnumParamText params = do
+  let
+    scanEach tm = do
+      mt <- assertNoTypeSignature tm
+      enumNames <- traverse (\t -> insertName (NE.singleton t) RnEnum) mt
+      pure $
+        RnTypedMulti
+          { rnTypedMultiExpr = fmap RnExprName enumNames
+          , rnTypedMultiTypeSig = Nothing
+          }
+
+  traverse_ scanEach params
+
+scanTypeDeclName :: RuleName -> Renamer ()
+scanTypeDeclName mtexprs = do
+  mt <- assertSingletonMultiTerm mtexprs
+  void $ insertName (NE.singleton mt) RnType
 
 -- ----------------------------------------------------------------------------
 -- Renamer passes
 -- ----------------------------------------------------------------------------
 
+renameLocalRules :: [Rule] -> Renamer ([RnRule], ScopeTable)
+renameLocalRules localRules = do
+  origScopeTable <- use scScopeTable
+  traverse_ scanRule localRules
+  localExports <- use scScopeTable
+  rnLocalRules <- traverse renameRule localRules
+  -- TODO: handle name conflicts
+  pure (rnLocalRules, origScopeTable `unionScopeTable` localExports)
+
 renameRule :: Rule -> Renamer RnRule
 renameRule rule@Rule.Hornlike{} = do
   super <- traverse renameTypeSignature rule.super
   given <- renameGivens rule.given
   giveth <- renameGiveths rule.giveth
+  (wwhere, scopeTableWithLocalDecls) <- renameLocalRules rule.wwhere
+  assign' scScopeTable scopeTableWithLocalDecls
   upon <- renameUpons rule.upon
-  wwhere <- traverse renameRule rule.wwhere
   defaults <- assertEmptyList rule.defaults
   symtab <- assertEmptyList rule.symtab
   clauses <- traverse renameHornClause rule.clauses
@@ -473,19 +617,19 @@ renameRule rule@Rule.Hornlike{} = do
   pure $
     Hornlike
       RnHornlike
-        { name = name
-        , super = super
+        { name
+        , super
         , keyword = rule.keyword
-        , given = given
-        , giveth = giveth
-        , upon = upon
-        , clauses = clauses
+        , given
+        , giveth
+        , upon
+        , clauses
         , rlabel = rule.rlabel
         , lsource = rule.lsource
-        , wwhere = wwhere
+        , wwhere
         , srcref = rule.srcref
-        , defaults = defaults
-        , symtab = symtab
+        , defaults
+        , symtab
         }
 renameRule r@Rule.Regulative{} = throwError $ "Unsupported rule: " <> show r
 renameRule r@Rule.Constitutive{} = throwError $ "Unsupported rule: " <> show r
@@ -525,7 +669,7 @@ renameRule r@Rule.NotARule{} = throwError $ "Unsupported rule: " <> show r
 renameTypeDeclName :: RuleName -> Renamer RnRuleName
 renameTypeDeclName mtexprs = do
   mt <- assertSingletonMultiTerm mtexprs
-  rnTyName <- insertName (NE.singleton mt) RnType
+  rnTyName <- lookupExistingName (NE.singleton mt) RnType
   pure [RnExprName rnTyName]
 
 renameUpons ::
@@ -561,7 +705,7 @@ renameGiven (mtExprs, typeSig) = do
 renameGivenMultiTerm :: NonEmpty LS.MTExpr -> Renamer RnName
 renameGivenMultiTerm mtExprs = do
   mt <- assertSingletonMultiTerm mtExprs
-  insertName (pure mt) RnVariable
+  lookupExistingName (pure mt) RnVariable
 
 renameTypeSignature ::
   LS.TypeSig ->
@@ -579,46 +723,14 @@ renameTypeSignature sig = case sig of
  where
   renameEntityType :: LS.EntityType -> Renamer RnEntityType
   renameEntityType eType =
-    -- This can either refer to an existing entity type, or define a new,
-    -- ad-hoc, entity type. We just assume that multiple ad-hoc definitions
-    -- of the same name in the same scope must be consistent.
-    lookupOrInsertName (mkSimpleOccName eType) RnType
+    lookupExistingName (mkSimpleOccName eType) RnType
 
--- | Rename an enum definition.
---
--- Why not reuse 'renameGivens'? It is basically the same type!
--- Well, we don't handle arbitrary nested type signatures.
--- In fact, it is a bit dubious we have them at all!
--- The following seems to be possible in theory:
---
--- @
--- GIVEN x IS ONE OF foo IS ONE OF foobar, foobaz
--- @
---
--- What would that suppose to mean? So, for now, we only allow enum definitions
--- to be of the following form:
---
--- @
--- GIVEN x IS ONE OF foo, bar, foo baz
--- @
---
--- This means 'x' is one of three possible enum values 'foo', 'bar'
--- and 'foo baz'.
---
--- TODO: We reuse this for Type declarations as well, are nested type signatures allowed in this case?
--- Even in that case, since 'TypeDecl''s 'has' is a list of 'TypeDecl''s, it seems like
--- there is no arbitrary nesting.
---
--- ANDRES: I think the fact that type signatures allow nested
--- type signatures is a shortcoming of the input syntax that should
--- be fixed at that level.
 renameGivenInlineEnumParamText :: LS.ParamText -> Renamer RnParamText
 renameGivenInlineEnumParamText params = do
   let
     renameEach tm = do
       mt <- assertNoTypeSignature tm
-      _t <- assertMultiExprIsOnlyText mt -- unclear if we really want this
-      enumNames <- traverse (\t -> insertName (NE.singleton t) RnEnum) mt
+      enumNames <- traverse (\t -> lookupExistingName (NE.singleton t) RnEnum) mt
       pure $
         RnTypedMulti
           { rnTypedMultiExpr = fmap RnExprName enumNames
@@ -630,7 +742,7 @@ renameGivenInlineEnumParamText params = do
 
 renameHornClause :: LS.HornClause2 -> Renamer RnHornClause
 renameHornClause hc = do
-  rnHead <- renameDecideHeadClause hc.hHead
+  rnHead <- renameRelationalPredicate hc.hHead
   rnBody <- traverse renameBoolStruct hc.hBody
   pure $
     RnHornClause
@@ -638,132 +750,6 @@ renameHornClause hc = do
       , rnHcBody = rnBody
       }
 
--- Special renaming function for the relational predicates that occur in
--- the head of @DECIDE clauses@, e.g. @DECIDE foo IS bar@.
---
--- We detect the occurrence of @IS@ and treat it in a special way,
--- and in the case of a multi-term, we use 'renameDecideMultiTerm'
--- which allows the *introduction* of variables rather than just referencing
--- them.
---
-renameDecideHeadClause :: LS.RelationalPredicate -> Renamer RnRelationalPredicate
-renameDecideHeadClause = \case
-  LS.RPParamText pText -> throwError $ "Received 'RPParamText', we can't handle that yet. Got: " <> show pText
-  LS.RPMT mt -> RnRelationalTerm <$> renameDecideMultiTerm mt
-  LS.RPConstraint lhs relationalPredicate rhs -> do
-    rnLhs <- renameDecideMultiTerm lhs
-    rnRhs <- renameMultiTerm rhs
-    pure $ RnConstraint rnLhs relationalPredicate rnRhs
-  LS.RPBoolStructR lhs relationalPredicate rhs -> do
-    rnLhs <- renameDecideMultiTerm lhs
-    rnRhs <- renameBoolStruct rhs
-    pure $ RnBoolStructR rnLhs relationalPredicate rnRhs
-  LS.RPnary LS.RPis (lhs : rhs) -> do
-    -- When the assignment has multiple complicated relational predicates,
-    -- it is translated to this 'RPNary'. Then the first element is before the 'IS'
-    -- and the rest after.
-    -- Example:
-    -- @f x IS SUM(x, x, x)@
-    -- is parsed to @RPnary RPis [[f, x], [RPnary RPSum [x, x, x]]]@
-    -- ignoring some details.
-    rnLhs <- renameDecideHeadClause lhs
-    rnRhs <- traverse renameRelationalPredicate rhs
-    pure $ RnNary LS.RPis (rnLhs : rnRhs)
-  LS.RPnary relationalPredicate rhs -> do
-    rnRhs <- traverse renameRelationalPredicate rhs
-    pure $ RnNary relationalPredicate rnRhs
-
--- | Rename a top-level occurrence of 'LS.MultiTerm'.
---
--- This is slightly special, as this may be the definition site of functions.
---
--- For now, we accept the following 'LS.MultiTerm''s for function definitions:
---
--- * @f x@: function @f@ in prefix with parameter @x@
--- * @x f@: function @f@ in postfix with parameter @x@
--- * @f x y@: function @f@ in prefix with parameters @x@ and @y@
--- * @x f y@: function @f@ in infix with parameters @x@ and @y@
---
--- Note, to be recognized as a function, variables must have been specified by 'GIVEN'
--- clauses and the function name must be unbound in its current scope.
---
--- Additionally, we recognize the following forms:
---
--- * @f's x's y's z@: An attribute path from @f@ to something that has a @z@ attribute.
--- * @x@: a variable, might be bound ad-hoc
---
--- Note, this doesn't accept literals such as '42' or '3.5f'.
-renameDecideMultiTerm :: LS.MultiTerm -> Renamer RnMultiTerm
-renameDecideMultiTerm mt = do
-  ruleOccName <- use scRuleOccName
-  scopeTable <- (fromMaybe emptyScopeTable . lookup ruleOccName) <$> use scScopeTable
-  case mt of
-    attrs
-      | Just (obj, objAttrs) <- toObjectPath attrs -> do
-          -- DECIDE x IS ...
-          -- DECIDE x's y's z IS ...
-          rnName <- lookupOrInsertName (mkSimpleOccName obj) RnVariable
-          rnObjAttrs <- mapM (\attr -> RnExprName <$> lookupOrInsertName (mkSimpleOccName attr) RnSelector) objAttrs
-          pure $ RnExprName rnName : rnObjAttrs
-
-    -- ANDRES: I think we should generalise this to something like
-    -- the following:
-    --
-    -- If we have a list of names x_1, x_2, ... x_n, check if
-    -- there is an x_i such that all x_j with i /= j are known
-    -- (givens), and x_i is either unknown, or already known as
-    -- a function.
-    --
-    -- I'm not completely sure if this is enough, because we probably
-    -- should be more precise about shadowing existing functions ...
-    --
-    [LS.MTT f, LS.MTT x]
-      | Just [rnX] <- variableAndFunction scopeTable [x] f -> do
-          rnF <- lookupOrInsertName (mkSimpleOccName f) RnFunction
-          insertFunction rnF (FuncInfo{funcArity = (0, 1)})
-          pure $ [RnExprName rnF, RnExprName rnX]
-    [LS.MTT x, LS.MTT f]
-      | Just [rnX] <- variableAndFunction scopeTable [x] f -> do
-          rnF <- lookupOrInsertName (mkSimpleOccName f) RnFunction
-          insertFunction rnF (FuncInfo{funcArity = (1, 0)})
-          pure $ [RnExprName rnF, RnExprName rnX]
-    [LS.MTT x, LS.MTT f, LS.MTT y]
-      | Just [rnX, rnY] <- variableAndFunction scopeTable [x, y] f -> do
-          rnF <- lookupOrInsertName (mkSimpleOccName f) RnFunction
-          insertFunction rnF (FuncInfo{funcArity = (1, 1)})
-          pure $ [RnExprName rnF, RnExprName rnX, RnExprName rnY]
-    [LS.MTT f, LS.MTT x, LS.MTT y]
-      | Just [rnX, rnY] <- variableAndFunction scopeTable [x, y] f -> do
-          rnF <- lookupOrInsertName (mkSimpleOccName f) RnFunction
-          insertFunction rnF (FuncInfo{funcArity = (0, 2)})
-          pure $ [RnExprName rnF, RnExprName rnX, RnExprName rnY]
-    [] -> throwError "renameDecideMultiTerm: Unexpected empty list of MultiTerm"
-    unknownPattern -> throwError $ "While renaming a multi term in a top-level DECIDE clause, we encountered an unsupported pattern: " <> show unknownPattern
-
--- | Check whether this could be a function like structure.
---
--- It might be, if all the variables are already bound, and the function name
--- is unbound or already known as a function.
---
--- ANDRES: It surprises me that we do not have to check whether
--- the arity matches.
-variableAndFunction :: ScopeTable -> [Text] -> Text -> Maybe [RnName]
-variableAndFunction st variables function = do
-  -- TODO: this is wrong, only consider arguments in the GIVEN's, otherwise
-  -- that's name shadowing. E.g.
-  --
-  -- @
-  -- GIVEN x DECIDE f x y IS SUM(x, y) WHERE y IS 5
-  -- @
-  rnBoundVariables <- traverse ((`Map.lookup` st._stVariables) . mkSimpleOccName) variables
-  case mkSimpleOccName function `Map.lookup` st._stVariables of
-    -- The function name must be either unbound, or
-    -- registered as a function.
-    Just fnName
-      | fnName.rnNameType == RnFunction -> Just rnBoundVariables
-      | otherwise -> Nothing
-    Nothing -> Just rnBoundVariables
-
 renameRelationalPredicate :: LS.RelationalPredicate -> Renamer RnRelationalPredicate
 renameRelationalPredicate = \case
   LS.RPParamText pText -> throwError $ "Received 'RPParamText', we can't handle that yet. Got: " <> show pText
@@ -793,7 +779,7 @@ renameBoolStruct = \case
 
 renameMultiTerm :: LS.MultiTerm -> Renamer RnMultiTerm
 renameMultiTerm multiTerms = do
-  (results, _finalCtx) <-
+  (reversedRnMultiTerms, ctx) <-
     foldM
       ( \(results, state) mt -> do
           (rnExpr, newState) <- renameMultiTermExpression state mt
@@ -801,11 +787,24 @@ renameMultiTerm multiTerms = do
       )
       ([], initialMultiTermContext)
       multiTerms
-  pure $ reverse results
+  let
+    rnMultiTerms = reverse reversedRnMultiTerms
+  fixityFixedRnMultiTerms <- fixFixity ctx rnMultiTerms
+  pure fixityFixedRnMultiTerms
  where
+  fixFixity ctx rnMultiTerms = case ctx ^. functionCall of
+    Nothing -> pure rnMultiTerms
+    Just fnName -> do
+      let
+        (preArgs, postArgsWithName) = List.break (== (RnExprName fnName)) rnMultiTerms
+      case postArgsWithName of
+        [] -> throwError ""
+        (fnExpr : postArgs) -> pure $ fnExpr : preArgs ++ postArgs
+
   initialMultiTermContext =
     MultiTermContext
       { _multiTermContextInSelector = False
+      , _multiTermContextFunctionCall = Nothing
       }
 
 renameMultiTermExpression :: MultiTermContext -> LS.MTExpr -> Renamer (RnExpr, MultiTermContext)
@@ -820,27 +819,35 @@ renameMultiTermExpression ctx = \case
   -- We ignore this for now, though.
   LS.MTT name -> case isGenitive name of
     Nothing -> do
+      let
+        ctx' = notInSelectorContext ctx
       lookupName (mkSimpleOccName name) >>= \case
-        Just rnName -> pure (RnExprName rnName, notInSelectorContext ctx)
+        Just rnName -> do
+          let
+            ctx'' =
+              if rnName.rnNameType == RnFunction
+                then ctx' & functionCall ?~ rnName
+                else ctx'
+          pure (RnExprName rnName, ctx'')
         Nothing
           | Just literal <- isTextLiteral name ->
-              pure (RnExprLit $ RnString literal, notInSelectorContext ctx)
+              pure (RnExprLit $ RnString literal, ctx')
           | isL4BuiltIn name -> do
               -- ANDRES: I'm not convinced that built-ins should be renamed, and
               -- if we already detected that they're built-ins, perhaps we should
               -- just use a different dedicated constructor for this case.
               rnName <- RnExprName <$> rnL4Builtin name
-              pure (rnName, notInSelectorContext ctx)
-          | ctx ^. multiTermContextInSelector -> do
+              pure (rnName, ctx')
+          | ctx ^. inSelector -> do
               rnName <- RnExprName <$> insertName (mkSimpleOccName name) RnSelector
-              pure (rnName, notInSelectorContext ctx)
+              pure (rnName, ctx')
           | otherwise -> do
               -- If this is not a selector, or a known variable, we infer
               -- it is a string type. This is ok, because users can
               -- disambiguate variables and string literals by enclosing the
               -- literal in quotes, e.g. @"This is a string"@
               --
-              pure (RnExprLit $ RnString name, notInSelectorContext ctx)
+              pure (RnExprLit $ RnString name, ctx')
     Just nameSelector -> do
       -- Is this name known already?
       -- If not, we assume this is a selector we haven't encountered before.
@@ -887,29 +894,11 @@ oTHERWISE = "OTHERWISE"
 -- by giving us exactly what we need, followed by throwErroring if assumptions are violated.
 -- ----------------------------------------------------------------------------
 
--- | Assert the collection of 'MTExpr' consists only of text fragments.
---
--- TODO: This is lossy, we can't reconstruct the 'NonEmpty LS.MTExpr' given the
--- text. Fix this! It is likely wrong, too.
-assertMultiExprIsOnlyText :: NonEmpty LS.MTExpr -> Renamer Text
-assertMultiExprIsOnlyText mtt = do
-  xs <- traverse assertExprIsText mtt
-  pure $ Text.unwords $ NE.toList xs
-
 assertSingletonMultiTerm :: (Show (f LS.MTExpr), Foldable f) => f LS.MTExpr -> Renamer LS.MTExpr
 assertSingletonMultiTerm xs = case Foldable.toList xs of
   [x] -> pure x
   _ -> throwError $ "Expected singleton but got: " <> show xs
 
-assertMultiExprIsText :: NonEmpty LS.MTExpr -> Renamer Text
-assertMultiExprIsText mts = do
-  mt <- assertSingletonMultiTerm mts
-  assertExprIsText mt
-
-assertExprIsText :: LS.MTExpr -> Renamer Text
-assertExprIsText (LS.MTT t) = pure t
-assertExprIsText mt = throwError $ "Expected MTT but got: " <> show mt
-
 assertNoTypeSignature :: LS.TypedMulti -> Renamer (NonEmpty LS.MTExpr)
 assertNoTypeSignature tm@(_, Just _) = throwError $ "Expected no type signature but got: " <> show tm
 assertNoTypeSignature (mtt, Nothing) = do
diff --git a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
index fbc2dde78..a5164f878 100644
--- a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
+++ b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
@@ -702,7 +702,7 @@ WHERE
 |]
 
 -- >>> transpileRulePure exampleWithOneOf
--- "let f_g_4 = fun(v_d_0) => let v_y_1 = if v_d_0 > 0 then 'green else if b_OTHERWISE_3 then 'red else undefined in v_y_1"
+-- "let f_g_4 = fun(v_d_0) => let v_y_1 = if v_d_0 > 0 then e_green_2 else if b_OTHERWISE_5 then e_red_3 else undefined in v_y_1"
 
 exampleWithOneOf :: String
 exampleWithOneOf =
@@ -716,7 +716,7 @@ WHERE
 |]
 
 -- >>> transpileRulePure bookWithAttributes
--- "let f_g_4 = fun(v_d_0) => let v_y_1 = {s_book_2 = if v_d_0 > 0 then 'green else if b_OTHERWISE_3 then 'red else undefined} in v_y_1"
+-- "let f_g_1 = fun(v_d_0) => let v_y_2 = {s_book_3 = if v_d_0 > 0 then 'green else if b_OTHERWISE_4 then 'red else undefined} in v_y_2"
 
 bookWithAttributes :: String
 bookWithAttributes =
@@ -808,7 +808,7 @@ DECIDE f x IS 1 IF x > 0;
 |]
 
 -- >>> transpileRulePure decideWithAttributes
--- "let f_f_4 = fun(v_x_0) => let v_y_1 = {s_p_3 = v_x_0 + v_x_0,s_z_2 = 0} in v_y_1"
+-- "let f_f_1 = fun(v_x_0) => let v_y_2 = {s_p_4 = v_x_0 + v_x_0,s_z_3 = 0} in v_y_2"
 
 decideWithAttributes :: String
 decideWithAttributes =
@@ -821,7 +821,7 @@ WHERE
 |]
 
 -- >>> transpileRulePure decideWithSimpleConditionalAttributes
--- "let f_f_3 = fun(v_x_0) => let v_y_1 = {s_z_2 = if v_x_0 > 3 then 5 else undefined} in v_y_1"
+-- "let f_f_1 = fun(v_x_0) => let v_y_2 = {s_z_3 = if v_x_0 > 3 then 5 else undefined} in v_y_2"
 
 decideWithSimpleConditionalAttributes :: String
 decideWithSimpleConditionalAttributes =
@@ -833,7 +833,7 @@ WHERE
 |]
 
 -- >>> transpileRulePure decideWithConditionalAttributes
--- "let f_f_5 = fun(v_x_0) => let v_y_1 = {s_p_4 = if v_x_0 > 5 then v_x_0 else if b_OTHERWISE_3 then v_x_0 + v_x_0 else undefined,s_z_2 = if v_x_0 > 3 then 5 else if b_OTHERWISE_3 then 0 else undefined} in v_y_1"
+-- "let f_f_1 = fun(v_x_0) => let v_y_2 = {s_p_4 = if v_x_0 > 5 then v_x_0 else if b_OTHERWISE_5 then v_x_0 + v_x_0 else undefined,s_z_3 = if v_x_0 > 3 then 5 else if b_OTHERWISE_5 then 0 else undefined} in v_y_2"
 
 decideWithConditionalAttributes :: String
 decideWithConditionalAttributes =

From 6042cdc6fad6fa8d0137e2746a0c0e5d4174b6b0 Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Fri, 9 Aug 2024 16:37:00 +0200
Subject: [PATCH 17/44] Update Simala Spec tests

---
 lib/haskell/natural4/test/LS/RenamerSpec.hs   |  14 +-
 .../natural4/test/LS/XPile/SimalaSpec.hs      | 231 +++++++++++++++---
 .../renamer/decide-with-attributes.expected   |  24 +-
 .../testdata/golden/renamer/id-func.expected  |   4 +-
 .../xpile/simala/bookWithAttributes.expected  |   2 -
 .../eragon-book-with-attributes.expected      |   1 +
 .../golden/xpile/simala/eragon-book.expected  |   1 +
 .../golden/xpile/simala/function-id.expected  |   1 +
 .../simala/function-nested-selector.expected  |   1 +
 .../xpile/simala/function-record.expected     |   1 +
 .../xpile/simala/function-selector.expected   |   1 +
 .../golden/xpile/simala/function-sum.expected |   1 +
 .../function-with-attributes-1.expected       |   1 +
 ...on-with-attributes-conditionals-1.expected |   1 +
 ...on-with-attributes-conditionals-2.expected |   1 +
 .../function-with-conditionals-1.expected     |   1 +
 .../function-with-conditionals-2.expected     |   1 +
 .../function-with-conditionals-3.expected     |   1 +
 .../simala/giveth-record-nested.expected      |   1 +
 .../xpile/simala/giveth-record.expected       |   1 +
 .../golden/xpile/simala/giveth.expected       |   1 +
 .../testdata/golden/xpile/simala/id.expected  |   1 -
 .../no-giveth-adhoc-y-attribute.expected      |   1 +
 .../xpile/simala/no-giveth-adhoc-y.expected   |   1 +
 .../xpile/simala/rodents-and-vermin.expected  |   2 +
 25 files changed, 236 insertions(+), 60 deletions(-)
 delete mode 100644 lib/haskell/natural4/test/testdata/golden/xpile/simala/bookWithAttributes.expected
 create mode 100644 lib/haskell/natural4/test/testdata/golden/xpile/simala/eragon-book-with-attributes.expected
 create mode 100644 lib/haskell/natural4/test/testdata/golden/xpile/simala/eragon-book.expected
 create mode 100644 lib/haskell/natural4/test/testdata/golden/xpile/simala/function-id.expected
 create mode 100644 lib/haskell/natural4/test/testdata/golden/xpile/simala/function-nested-selector.expected
 create mode 100644 lib/haskell/natural4/test/testdata/golden/xpile/simala/function-record.expected
 create mode 100644 lib/haskell/natural4/test/testdata/golden/xpile/simala/function-selector.expected
 create mode 100644 lib/haskell/natural4/test/testdata/golden/xpile/simala/function-sum.expected
 create mode 100644 lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-1.expected
 create mode 100644 lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-conditionals-1.expected
 create mode 100644 lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-conditionals-2.expected
 create mode 100644 lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-1.expected
 create mode 100644 lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-2.expected
 create mode 100644 lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-3.expected
 create mode 100644 lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth-record-nested.expected
 create mode 100644 lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth-record.expected
 create mode 100644 lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth.expected
 delete mode 100644 lib/haskell/natural4/test/testdata/golden/xpile/simala/id.expected
 create mode 100644 lib/haskell/natural4/test/testdata/golden/xpile/simala/no-giveth-adhoc-y-attribute.expected
 create mode 100644 lib/haskell/natural4/test/testdata/golden/xpile/simala/no-giveth-adhoc-y.expected
 create mode 100644 lib/haskell/natural4/test/testdata/golden/xpile/simala/rodents-and-vermin.expected

diff --git a/lib/haskell/natural4/test/LS/RenamerSpec.hs b/lib/haskell/natural4/test/LS/RenamerSpec.hs
index c322cea1f..93a880357 100644
--- a/lib/haskell/natural4/test/LS/RenamerSpec.hs
+++ b/lib/haskell/natural4/test/LS/RenamerSpec.hs
@@ -61,12 +61,14 @@ spec = do
   test rule = test' rule rule
 
   test' desc fname ruleSource = do
-    let
-      rule :: Rule = fromRight RegBreach $ run ruleSource
-    let
-      rnRule :: Either String Renamer.RnRule =
-        State.evalState (Except.runExceptT (Renamer.runRenamer $ Renamer.renameRule rule)) Renamer.emptyScope
-    it desc $ goldenGeneric fname $ rnRule
+    it desc $ do
+      let
+        Right rules = runList ruleSource
+        rnRules =
+          State.evalState
+            (Except.runExceptT (Renamer.runRenamer $ Renamer.renamer rules))
+            Renamer.emptyScope
+      goldenGeneric fname rnRules
 
 type Err = Either String
 type ParseFun a = [Token] -> Err a
diff --git a/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs b/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
index 9e426901e..791be995b 100644
--- a/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
+++ b/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
@@ -24,49 +24,206 @@ import TextuaL4.Transform qualified as Parser
 spec :: Spec
 spec = do
   describe "rule transpilation" do
-    it "id" $
-      runSimalaTranspilerForRule
-        "id"
-        [i|
-            GIVEN x
-            DECIDE id x IS x
-            |]
+    describe "basic" do
+      basicTests
+    describe "real-world" do
+      realWorldTests
 
-    it "bookWithAttributes" $
-      runSimalaTranspilerForRule
-        "bookWithAttributes"
-        [i|
-            GIVEN d
-            DECIDE g d IS y
-            WHERE
-                y's book IS green IF d > 0;
-                y's book IS red OTHERWISE
-            |]
+basicTests = do
+  transpilerTest
+    "function-id"
+    [i|
+      GIVEN x
+      DECIDE id x IS x
+      |]
+  transpilerTest
+    "function-record"
+    [i|
+      GIVEN d
+      DECIDE g d IS y
+      WHERE
+          y's book IS green IF d > 0;
+          y's book IS red OTHERWISE
+      |]
+  transpilerTest
+    "function-sum"
+    [i|
+      GIVEN x
+      DECIDE sum3 x IS SUM(x, x, x)
+      |]
+  transpilerTest
+    "function-selector"
+    [i|
+      GIVEN x
+      DECIDE f x IS x's z
+      |]
+  transpilerTest
+    "function-nested-selector"
+    [i|
+      GIVEN x
+      DECIDE f x IS x's y's z
+      |]
+  transpilerTest
+    "function-with-conditionals-1"
+    [i|
+      GIVEN x
+      DECIDE f x IS 1 IF x > 0;
+              f x IS 0 OTHERWISE;
+              f x IS 2 IF x < 0
+      |]
+  transpilerTest
+    "function-with-conditionals-2"
+    [i|
+      GIVEN x
+      DECIDE f x IS 1 IF x > 0;
+              f x IS 0 OTHERWISE
+      |]
+  transpilerTest
+    "function-with-conditionals-3"
+    [i|
+      GIVEN x
+      DECIDE f x IS 1 IF x > 0;
+              f x IS 0
+      |]
+  transpilerTest
+    "function-with-attributes-1"
+    [i|
+      GIVEN x
+      DECIDE f x IS y
+      WHERE
+        y's z IS 0;
+        y's p IS SUM(x, x)
+      |]
+  transpilerTest
+    "function-with-attributes-conditionals-1"
+    [i|
+      GIVEN x
+      DECIDE f x IS y
+      WHERE
+        y's z IS 5 IF x > 3
+      |]
+  transpilerTest
+    "function-with-attributes-conditionals-2"
+    [i|
+      GIVEN x
+      DECIDE f x IS y
+      WHERE
+        y's z IS 5 IF x > 3;
+        y's z IS 0 OTHERWISE;
 
-runSimalaTranspilerForRule :: String -> String -> Golden TL.Text
-runSimalaTranspilerForRule outputName ruleString = goldenGeneric outputName $
-  case run ruleString of
-    Left err -> "Failed to parse program:\n" <> ruleString
-    Right rule -> do
-      case Renamer.renameRuleTopLevel' rule of
-        (Left err, scope) ->
-          unlines
-            [ "Renaming failed for program:"
-            , ruleString
-            , "Because:"
-            , err
-            , "Scope table:"
-            , pShowNoColorS scope
-            ]
-        (Right rnRule, _) -> do
-          case runExcept (Simala.ruleToSimala rnRule) of
-            Left err -> "Failed transpilation:\n" <> err
-            Right simala -> Text.unpack $ Simala.render simala
+        y's p IS x IF x > 5;
+        y's p IS SUM(x, x) OTHERWISE
+      |]
+  transpilerTest
+    "giveth"
+    [i|
+      GIVETH x
+      DECIDE x IS y
+      WHERE
+          y IS 5
+      |]
+  transpilerTest
+    "giveth-record"
+    [i|
+      GIVETH y
+      DECIDE y's z IS 5
+      |]
+  transpilerTest
+    "giveth-record-nested"
+    [i|
+      GIVETH y
+      DECIDE y's a's b's c's z IS 5
+      |]
+  transpilerTest
+    "eragon-book"
+    [i|
+      GIVETH eragon
+      DECIDE
+        eragon's title IS Eragon;
+        eragon's size IS 512;
+        eragon's character's main IS "Eragon";
+        eragon's character's villain IS "Galbatorix";
+        eragon's character's friend IS "Ork"
+      |]
+  transpilerTest
+    "eragon-book-with-attributes"
+    [i|
+      GIVETH eragon
+      DECIDE
+        eragon IS localVar
+      WHERE
+        localVar's title IS "Eragon";
+        localVar's size IS 512;
+        localVar's character's main IS "Eragon";
+        localVar's character's villain IS "Galbatorix";
+        localVar's character's friend IS "Ork"
+      |]
+  transpilerTest
+    "no-giveth-adhoc-y"
+    [i|
+      DECIDE y IS 5
+      |]
+  transpilerTest
+    "no-giveth-adhoc-y-attribute"
+    [i|
+      DECIDE y's z IS 5
+      |]
+
+realWorldTests = do
+  transpilerTest
+    "rodents-and-vermin"
+    [i|
+§ "Rodents and vermin"
+DECIDE "Not Covered"
+IF
+  UNLESS ( "Loss or Damage" IS ANY ( "caused by rodents"
+                                    , "caused by insects"
+                                    , "caused by vermin"
+                                    , "caused by birds"
+                                    )
+
+          , ANY ( ALL ( "Loss or Damage" IS "to Contents"
+                      , "Loss or Damage" IS "caused by birds"
+                      )
+
+                , UNLESS ( "Loss or Damage" IS "ensuing covered loss"
+
+                        , ANY ( "any other exclusion applies"
+                              , "an animal caused water to escape from"
+                                    ANY ( "a household appliance"
+                                        , "a swimming pool"
+                                        , "a plumbing, heating, or air conditioning system" )
+                              )
+                        )
+                )
+        )
+        |]
+
+transpilerTest :: String -> String -> SpecWith (Arg (Golden TL.Text))
+transpilerTest outputName ruleString = it outputName $
+  goldenGeneric outputName $
+    case run ruleString of
+      Left err -> "Failed to parse program:\n" <> ruleString
+      Right rule -> do
+        case Renamer.renameRuleTopLevel' rule of
+          (Left err, scope) ->
+            unlines
+              [ "Renaming failed for program:"
+              , ruleString
+              , "Because:"
+              , err
+              , "Scope table:"
+              , pShowNoColorS scope
+              ]
+          (Right rnRule, _) -> do
+            case runExcept (Simala.ruleToSimala rnRule) of
+              Left err -> "Failed transpilation:\n" <> err
+              Right simala -> Text.unpack $ Simala.render simala
 
 goldenGeneric :: String -> String -> Golden TL.Text
 goldenGeneric name output_ =
   Golden
-    { output = Pretty.pStringNoColor output_
+    { output = TL.pack output_
     , encodePretty = TL.unpack
     , writeToFile = TL.writeFile
     , readFromFile = TL.readFile
diff --git a/lib/haskell/natural4/test/testdata/golden/renamer/decide-with-attributes.expected b/lib/haskell/natural4/test/testdata/golden/renamer/decide-with-attributes.expected
index 3c020cbac..da083fab3 100644
--- a/lib/haskell/natural4/test/testdata/golden/renamer/decide-with-attributes.expected
+++ b/lib/haskell/natural4/test/testdata/golden/renamer/decide-with-attributes.expected
@@ -1,11 +1,11 @@
 Right
-    ( Hornlike
+    [ Hornlike
         ( RnHornlike
             { name =
                 [ RnExprName
                     ( RnName
                         { rnOccName = MTT "g" :| []
-                        , rnUniqueId = 4
+                        , rnUniqueId = 1
                         , rnNameType = RnFunction
                         }
                     )
@@ -41,7 +41,7 @@ Right
                         [ RnExprName
                             ( RnName
                                 { rnOccName = MTT "g" :| []
-                                , rnUniqueId = 4
+                                , rnUniqueId = 1
                                 , rnNameType = RnFunction
                                 }
                             )
@@ -56,7 +56,7 @@ Right
                         [ RnExprName
                             ( RnName
                                 { rnOccName = MTT "y" :| []
-                                , rnUniqueId = 1
+                                , rnUniqueId = 2
                                 , rnNameType = RnVariable
                                 }
                             )
@@ -73,14 +73,14 @@ Right
                             [ RnExprName
                                 ( RnName
                                     { rnOccName = MTT "y" :| []
-                                    , rnUniqueId = 1
+                                    , rnUniqueId = 2
                                     , rnNameType = RnVariable
                                     }
                                 )
                             , RnExprName
                                 ( RnName
                                     { rnOccName = MTT "book" :| []
-                                    , rnUniqueId = 2
+                                    , rnUniqueId = 3
                                     , rnNameType = RnSelector
                                     }
                                 )
@@ -96,14 +96,14 @@ Right
                                     [ RnExprName
                                         ( RnName
                                             { rnOccName = MTT "y" :| []
-                                            , rnUniqueId = 1
+                                            , rnUniqueId = 2
                                             , rnNameType = RnVariable
                                             }
                                         )
                                     , RnExprName
                                         ( RnName
                                             { rnOccName = MTT "book" :| []
-                                            , rnUniqueId = 2
+                                            , rnUniqueId = 3
                                             , rnNameType = RnSelector
                                             }
                                         )
@@ -133,14 +133,14 @@ Right
                                     [ RnExprName
                                         ( RnName
                                             { rnOccName = MTT "y" :| []
-                                            , rnUniqueId = 1
+                                            , rnUniqueId = 2
                                             , rnNameType = RnVariable
                                             }
                                         )
                                     , RnExprName
                                         ( RnName
                                             { rnOccName = MTT "book" :| []
-                                            , rnUniqueId = 2
+                                            , rnUniqueId = 3
                                             , rnNameType = RnSelector
                                             }
                                         )
@@ -154,7 +154,7 @@ Right
                                             [ RnExprName
                                                 ( RnName
                                                     { rnOccName = MTT "OTHERWISE" :| []
-                                                    , rnUniqueId = 3
+                                                    , rnUniqueId = 4
                                                     , rnNameType = RnBuiltin
                                                     }
                                                 )
@@ -193,4 +193,4 @@ Right
             , symtab = []
             }
         )
-    )
\ No newline at end of file
+    ]
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/renamer/id-func.expected b/lib/haskell/natural4/test/testdata/golden/renamer/id-func.expected
index 09369fbec..9703857f1 100644
--- a/lib/haskell/natural4/test/testdata/golden/renamer/id-func.expected
+++ b/lib/haskell/natural4/test/testdata/golden/renamer/id-func.expected
@@ -1,5 +1,5 @@
 Right
-    ( Hornlike
+    [ Hornlike
         ( RnHornlike
             { name =
                 [ RnExprName
@@ -80,4 +80,4 @@ Right
             , symtab = []
             }
         )
-    )
\ No newline at end of file
+    ]
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/bookWithAttributes.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/bookWithAttributes.expected
deleted file mode 100644
index 72533e21d..000000000
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/bookWithAttributes.expected
+++ /dev/null
@@ -1,2 +0,0 @@
-let f_g_4 = fun( v_d_0 ) => let v_y_1 =
-    { s_book_2 = if v_d_0 > 0 then 'green else if b_OTHERWISE_3 then 'red else undefined } in v_y_1
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/eragon-book-with-attributes.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/eragon-book-with-attributes.expected
new file mode 100644
index 000000000..724f8456b
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/eragon-book-with-attributes.expected
@@ -0,0 +1 @@
+let v_eragon_0 = let v_localVar_1 = {s_character_4 = {s_friend_7 = 'Ork,s_main_5 = 'Eragon,s_villain_6 = 'Galbatorix},s_size_3 = 512,s_title_2 = 'Eragon} in v_localVar_1
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/eragon-book.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/eragon-book.expected
new file mode 100644
index 000000000..329d137a0
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/eragon-book.expected
@@ -0,0 +1 @@
+let v_eragon_0 = {s_character_3 = {s_friend_6 = 'Ork,s_main_4 = 'Eragon,s_villain_5 = 'Galbatorix},s_size_2 = 512,s_title_1 = 'Eragon}
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-id.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-id.expected
new file mode 100644
index 000000000..037027d4f
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-id.expected
@@ -0,0 +1 @@
+let f_id_1 = fun(v_x_0) => v_x_0
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-nested-selector.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-nested-selector.expected
new file mode 100644
index 000000000..cb1024ce8
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-nested-selector.expected
@@ -0,0 +1 @@
+let f_f_1 = fun(v_x_0) => v_x_0.s_y_2.s_z_3
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-record.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-record.expected
new file mode 100644
index 000000000..b04d66419
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-record.expected
@@ -0,0 +1 @@
+let f_g_1 = fun(v_d_0) => let v_y_2 = {s_book_3 = if v_d_0 > 0 then 'green else if b_OTHERWISE_4 then 'red else undefined} in v_y_2
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-selector.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-selector.expected
new file mode 100644
index 000000000..d760eefcc
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-selector.expected
@@ -0,0 +1 @@
+let f_f_1 = fun(v_x_0) => v_x_0.s_z_2
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-sum.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-sum.expected
new file mode 100644
index 000000000..49f44b0d4
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-sum.expected
@@ -0,0 +1 @@
+let f_sum3_1 = fun(v_x_0) => sum(v_x_0,v_x_0,v_x_0)
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-1.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-1.expected
new file mode 100644
index 000000000..9b76bb02f
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-1.expected
@@ -0,0 +1 @@
+let f_f_1 = fun(v_x_0) => let v_y_2 = {s_p_4 = v_x_0 + v_x_0,s_z_3 = 0} in v_y_2
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-conditionals-1.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-conditionals-1.expected
new file mode 100644
index 000000000..17028ac0c
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-conditionals-1.expected
@@ -0,0 +1 @@
+let f_f_1 = fun(v_x_0) => let v_y_2 = {s_z_3 = if v_x_0 > 3 then 5 else undefined} in v_y_2
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-conditionals-2.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-conditionals-2.expected
new file mode 100644
index 000000000..5f258df35
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-conditionals-2.expected
@@ -0,0 +1 @@
+let f_f_1 = fun(v_x_0) => let v_y_2 = {s_p_4 = if v_x_0 > 5 then v_x_0 else if b_OTHERWISE_5 then v_x_0 + v_x_0 else undefined,s_z_3 = if v_x_0 > 3 then 5 else if b_OTHERWISE_5 then 0 else undefined} in v_y_2
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-1.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-1.expected
new file mode 100644
index 000000000..358aaed2b
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-1.expected
@@ -0,0 +1 @@
+let f_f_1 = fun(v_x_0) => if v_x_0 > 0 then 1 else if b_OTHERWISE_2 then 0 else if v_x_0 < 0 then 2 else undefined
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-2.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-2.expected
new file mode 100644
index 000000000..365946cc1
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-2.expected
@@ -0,0 +1 @@
+let f_f_1 = fun(v_x_0) => if v_x_0 > 0 then 1 else if b_OTHERWISE_2 then 0 else undefined
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-3.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-3.expected
new file mode 100644
index 000000000..dce6d7e6b
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-3.expected
@@ -0,0 +1 @@
+let f_f_1 = fun(v_x_0) => if v_x_0 > 0 then 1 else 0
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth-record-nested.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth-record-nested.expected
new file mode 100644
index 000000000..047266c8f
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth-record-nested.expected
@@ -0,0 +1 @@
+let v_y_0 = {s_a_1 = {s_b_2 = {s_c_3 = {s_z_4 = 5}}}}
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth-record.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth-record.expected
new file mode 100644
index 000000000..d734fd83e
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth-record.expected
@@ -0,0 +1 @@
+let v_y_0 = {s_z_1 = 5}
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth.expected
new file mode 100644
index 000000000..8d5862886
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth.expected
@@ -0,0 +1 @@
+let v_x_0 = let v_y_1 = 5 in v_y_1
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/id.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/id.expected
deleted file mode 100644
index 40f7ef981..000000000
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/id.expected
+++ /dev/null
@@ -1 +0,0 @@
-let f_id_1 = fun( v_x_0 ) => v_x_0
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/no-giveth-adhoc-y-attribute.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/no-giveth-adhoc-y-attribute.expected
new file mode 100644
index 000000000..d734fd83e
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/no-giveth-adhoc-y-attribute.expected
@@ -0,0 +1 @@
+let v_y_0 = {s_z_1 = 5}
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/no-giveth-adhoc-y.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/no-giveth-adhoc-y.expected
new file mode 100644
index 000000000..5437efa4f
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/no-giveth-adhoc-y.expected
@@ -0,0 +1 @@
+let v_y_0 = 5
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/rodents-and-vermin.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/rodents-and-vermin.expected
new file mode 100644
index 000000000..e6f7a693d
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/rodents-and-vermin.expected
@@ -0,0 +1,2 @@
+Failed transpilation:
+Unsupported relational predicate: RPis
\ No newline at end of file

From 5452c9aaa42d64c257407ff1ce82fe85c21c0032 Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Fri, 9 Aug 2024 18:02:04 +0200
Subject: [PATCH 18/44] Implement full renaming pipeline for list of rules

---
 lib/haskell/natural4/src/LS/Renamer.hs        |  59 ++++----
 .../natural4/src/LS/XPile/Simala/Transpile.hs | 130 ++++++++++--------
 .../natural4/test/LS/XPile/SimalaSpec.hs      |   5 +-
 3 files changed, 113 insertions(+), 81 deletions(-)

diff --git a/lib/haskell/natural4/src/LS/Renamer.hs b/lib/haskell/natural4/src/LS/Renamer.hs
index b03424838..747666255 100644
--- a/lib/haskell/natural4/src/LS/Renamer.hs
+++ b/lib/haskell/natural4/src/LS/Renamer.hs
@@ -185,11 +185,11 @@ data Scope = Scope
   }
   deriving (Eq, Ord, Show)
 
-data BindingScope
-  = ToplevelScope
-  | WhereScope
-  | GivenScope
-  | GivethScope
+data BindingSite
+  = WhereClause
+  | GivenClause
+  | DecideClause
+  | GivethClause
   deriving (Eq, Ord, Show)
 
 -- | A 'ScopeTable' keeps tab on the variables and functions that occur in a
@@ -378,26 +378,26 @@ renamer rules = do
 -- 3. Types and selectors defined via 'DEFINE'
 scanRule :: Rule -> Renamer ()
 scanRule rule@Rule.Hornlike{} = do
+  scanGiveths rule.giveth
   -- TODO: givens should only be scanned for 'scanHornClause' and then removed again.
   scanGivens rule.given
-  scanGiveths rule.giveth
   traverse_ scanHornClause rule.clauses
-scanRule r@Rule.Regulative{} = throwError $ "Unsupported rule: " <> show r
-scanRule r@Rule.Constitutive{} = throwError $ "Unsupported rule: " <> show r
+scanRule r@Rule.Regulative{} = throwError $ "scanRule: Unsupported rule: " <> show r
+scanRule r@Rule.Constitutive{} = throwError $ "scanRule: Unsupported rule: " <> show r
 scanRule rule@Rule.TypeDecl{} = do
   traverse_ scanTypeSignature rule.super
   scanEnums rule.enums
   scanGivens rule.given
   traverse_ scanRule rule.has
   scanTypeDeclName rule.name
-scanRule r@Rule.Scenario{} = throwError $ "Unsupported rule: " <> show r
-scanRule r@Rule.DefNameAlias{} = throwError $ "Unsupported rule: " <> show r
-scanRule r@Rule.DefTypically{} = throwError $ "Unsupported rule: " <> show r
-scanRule r@Rule.RuleAlias{} = throwError $ "Unsupported rule: " <> show r
-scanRule r@Rule.RuleGroup{} = throwError $ "Unsupported rule: " <> show r
-scanRule r@Rule.RegFulfilled{} = throwError $ "Unsupported rule: " <> show r
-scanRule r@Rule.RegBreach{} = throwError $ "Unsupported rule: " <> show r
-scanRule r@Rule.NotARule{} = throwError $ "Unsupported rule: " <> show r
+scanRule r@Rule.Scenario{} = throwError $ "scanRule: Unsupported rule: " <> show r
+scanRule r@Rule.DefNameAlias{} = throwError $ "scanRule: Unsupported rule: " <> show r
+scanRule r@Rule.DefTypically{} = throwError $ "scanRule: Unsupported rule: " <> show r
+scanRule r@Rule.RuleAlias{} = throwError $ "scanRule: Unsupported rule: " <> show r
+scanRule r@Rule.RuleGroup{} = throwError $ "scanRule: Unsupported rule: " <> show r
+scanRule r@Rule.RegFulfilled{} = throwError $ "scanRule: Unsupported rule: " <> show r
+scanRule r@Rule.RegBreach{} = throwError $ "scanRule: Unsupported rule: " <> show r
+scanRule r@Rule.NotARule{} = throwError $ "scanRule: Unsupported rule: " <> show r
 
 -- | Scan a 'LS.HornClause2' for declarations of variables and functions.
 scanHornClause :: LS.HornClause2 -> Renamer ()
@@ -593,6 +593,13 @@ scanTypeDeclName mtexprs = do
 -- Renamer passes
 -- ----------------------------------------------------------------------------
 
+-- Lexical Scoping rules for hornlike rules:
+--
+-- GIVETH's are global
+-- GIVEN's are local
+-- DECIDE head term in "IS" clauses is global
+--
+
 renameLocalRules :: [Rule] -> Renamer ([RnRule], ScopeTable)
 renameLocalRules localRules = do
   origScopeTable <- use scScopeTable
@@ -631,8 +638,8 @@ renameRule rule@Rule.Hornlike{} = do
         , defaults
         , symtab
         }
-renameRule r@Rule.Regulative{} = throwError $ "Unsupported rule: " <> show r
-renameRule r@Rule.Constitutive{} = throwError $ "Unsupported rule: " <> show r
+renameRule r@Rule.Regulative{} = throwError $ "renameRule: Unsupported rule: " <> show r
+renameRule r@Rule.Constitutive{} = throwError $ "renameRule: Unsupported rule: " <> show r
 renameRule rule@Rule.TypeDecl{} = do
   super <- traverse renameTypeSignature rule.super
   defaults <- assertEmptyList rule.defaults
@@ -657,14 +664,14 @@ renameRule rule@Rule.TypeDecl{} = do
         , defaults
         , symtab
         }
-renameRule r@Rule.Scenario{} = throwError $ "Unsupported rule: " <> show r
-renameRule r@Rule.DefNameAlias{} = throwError $ "Unsupported rule: " <> show r
-renameRule r@Rule.DefTypically{} = throwError $ "Unsupported rule: " <> show r
-renameRule r@Rule.RuleAlias{} = throwError $ "Unsupported rule: " <> show r
-renameRule r@Rule.RuleGroup{} = throwError $ "Unsupported rule: " <> show r
-renameRule r@Rule.RegFulfilled{} = throwError $ "Unsupported rule: " <> show r
-renameRule r@Rule.RegBreach{} = throwError $ "Unsupported rule: " <> show r
-renameRule r@Rule.NotARule{} = throwError $ "Unsupported rule: " <> show r
+renameRule r@Rule.Scenario{} = throwError $ "renameRule: Unsupported rule: " <> show r
+renameRule r@Rule.DefNameAlias{} = throwError $ "renameRule: Unsupported rule: " <> show r
+renameRule r@Rule.DefTypically{} = throwError $ "renameRule: Unsupported rule: " <> show r
+renameRule r@Rule.RuleAlias{} = throwError $ "renameRule: Unsupported rule: " <> show r
+renameRule r@Rule.RuleGroup{} = throwError $ "renameRule: Unsupported rule: " <> show r
+renameRule r@Rule.RegFulfilled{} = throwError $ "renameRule: Unsupported rule: " <> show r
+renameRule r@Rule.RegBreach{} = throwError $ "renameRule: Unsupported rule: " <> show r
+renameRule r@Rule.NotARule{} = throwError $ "renameRule: Unsupported rule: " <> show r
 
 renameTypeDeclName :: RuleName -> Renamer RnRuleName
 renameTypeDeclName mtexprs = do
diff --git a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
index a5164f878..aff7ace32 100644
--- a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
+++ b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
@@ -23,14 +23,15 @@ import Data.Text.Lazy.IO qualified as TL
 import Optics
 import Text.Pretty.Simple qualified as Pretty
 
-import qualified LS.Rule as LS
-import qualified TextuaL4.Transform as Parser
-import qualified TextuaL4.ParTextuaL as Parser
 import LS.Renamer
 import LS.Renamer qualified as Renamer
+import LS.Rule qualified as LS
 import LS.Types qualified as LS
+import TextuaL4.ParTextuaL qualified as Parser
+import TextuaL4.Transform qualified as Parser
 
 import AnyAll.BoolStruct qualified as AA
+import Data.Maybe qualified as Maybe
 import Simala.Expr.Render qualified as Simala
 import Simala.Expr.Type qualified as Simala
 
@@ -87,7 +88,7 @@ data SimalaTerm
     -- @
     --
     -- Note, in practice, we might not remove 'OTHERWISE' and define a constant for it.
-    TermFunction Simala.Name [Simala.Name] Simala.Expr
+    TermFunction Simala.Transparency Simala.Name [Simala.Name] Simala.Expr
   | -- | A Let-In construct without an 'in' part.
     -- This is supposed to be used in simple variable assignment.
     TermLetIn Simala.Transparency Simala.Name Simala.Expr
@@ -100,18 +101,38 @@ data SimalaTerm
 -- Top Level transpilation functions and test helpers
 -- ----------------------------------------------------------------------------
 
-
+transpile :: (MonadError String m) => [RnRule] -> m Simala.Expr
+transpile rules = do
+  simalaTerms <- Maybe.catMaybes <$> traverse ruleToSimala rules
+  combineSimalaTerms Simala.Undefined simalaTerms
+
+combineSimalaTerms :: (MonadError String m) => Simala.Expr -> [SimalaTerm] -> m Simala.Expr
+combineSimalaTerms inExpr [] = pure inExpr
+combineSimalaTerms inExpr (TermLetIn t name expr : terms) = do
+  restOfInExpr <- combineSimalaTerms inExpr terms
+  pure $ mkLetIn t name expr restOfInExpr
+combineSimalaTerms inExpr (TermFunction t name params expr : terms) = do
+  restOfInExpr <- combineSimalaTerms inExpr terms
+  pure $ mkFunction t name params expr restOfInExpr
+combineSimalaTerms _inExpr _terms = do
+  throwError $ "combineSimalaTerms: Cannot combine SimalaTerms: " <> show _terms
 
 -- ----------------------------------------------------------------------------
 -- Main translation helpers
 -- ----------------------------------------------------------------------------
 
-ruleToSimala :: (MonadError String m) => RnRule -> m SimalaTerm
+ruleToSimala :: (MonadError String m) => RnRule -> m (Maybe SimalaTerm)
+ruleToSimala (TypeDecl _typedecl) =
+  -- Simala doesn't need to declare types, we can use anonymously.
+  -- We assume that ach rule has been typechecked already, so we don't need to
+  -- re-check anything.
+  --
+  pure Nothing
 ruleToSimala (Hornlike hornlike) = do
   terms <- hornClausesToSimala hornlike.clauses
   term <- assertSingletonList "ruleToSimala" terms
   subTerms <- traverse ruleToSimala hornlike.wwhere
-  foldInSubTerms term subTerms
+  Just <$> foldInSubTerms term (Maybe.catMaybes subTerms)
 
 -- ----------------------------------------------------------------------------
 -- Post Processing of rule translation.
@@ -168,7 +189,7 @@ groupClauses simalaTerms = do
  where
   compareClauseHeads :: SimalaTerm -> SimalaTerm -> Bool
   compareClauseHeads (TermLetIn _ name1 _) (TermLetIn _ name2 _) = name1 == name2
-  compareClauseHeads (TermFunction fnName1 _ _) (TermFunction fnName2 _ _) = fnName1 == fnName2
+  compareClauseHeads (TermFunction _ fnName1 _ _) (TermFunction _ fnName2 _ _) = fnName1 == fnName2
   compareClauseHeads (TermAttribute name1 _ _) (TermAttribute name2 _ _) = name1 == name2
   compareClauseHeads _ _ = False
 
@@ -183,16 +204,16 @@ foldInSubTerms top (x : xs) = case top of
   TermAttribute name selectors expr -> do
     exprWithLocals <- linearLetIns expr (x :| xs)
     pure $ TermAttribute name selectors exprWithLocals
-  TermFunction fnName fnParams fnExpr -> do
+  TermFunction t fnName fnParams fnExpr -> do
     fnExprWithLocals <- linearLetIns fnExpr (x :| xs)
-    pure $ TermFunction fnName fnParams fnExprWithLocals
+    pure $ TermFunction t fnName fnParams fnExprWithLocals
  where
   linearLetIns :: Simala.Expr -> NonEmpty SimalaTerm -> m Simala.Expr
-  linearLetIns finalExpr (x :| xs) = do
-    inExpr <- case xs of
+  linearLetIns finalExpr terms = do
+    inExpr <- case NE.tail terms of
       [] -> pure finalExpr
       (a : as) -> linearLetIns finalExpr (a :| as)
-    case x of
+    case NE.head terms of
       TermApp{} -> throwError $ "linearLetIns: Unexpected SimalaTerm: " <> show top
       TermLetIn t name expr -> do
         pure $ mkLetIn t name expr inExpr
@@ -201,8 +222,8 @@ foldInSubTerms top (x : xs) = case top of
         pure $ mkLetIn Simala.Transparent name expr inExpr
       TermAttribute name (a : as) expr -> do
         pure $ mkLetIn Simala.Transparent name (buildRecordUpdate (a :| as) expr) inExpr
-      TermFunction fnName fnParams fnExpr -> do
-        pure $ mkLetIn Simala.Transparent fnName (Simala.Fun Simala.Transparent fnParams fnExpr) inExpr
+      TermFunction t fnName fnParams fnExpr -> do
+        pure $ mkLetIn t fnName (Simala.Fun Simala.Transparent fnParams fnExpr) inExpr
 
 -- | Given a collection of groups, merge each group into a single expression.
 mergeGroups :: (Traversable t, MonadError String m) => t (NonEmpty (SimalaTerm, Maybe Simala.Expr)) -> m (t SimalaTerm)
@@ -223,11 +244,11 @@ mergeGroups' terms@((TermAttribute name _ _, _) :| _) = do
 mergeGroups' ((term, Nothing) :| _) =
   pure term
 mergeGroups' ((term, Just g) :| []) = do
-  ifThenElseTerm <- mkIfThenElse g term mkUndefinedTerm
+  ifThenElseTerm <- mkIfThenElseTerm g term mkUndefinedTerm
   pure ifThenElseTerm
 mergeGroups' ((term, Just g) :| (n : ns)) = do
   elseBranch <- mergeGroups' (n :| ns)
-  mkIfThenElse g term elseBranch
+  mkIfThenElseTerm g term elseBranch
 
 mergeAttributes :: (MonadError String m) => Simala.Name -> NonEmpty ([Simala.Name], Simala.Expr, Maybe Simala.Expr) -> m SimalaTerm
 mergeAttributes name terms = do
@@ -291,10 +312,10 @@ relationalPredicateToSimala = \case
     (mtHead : args)
       | Just (fnName, fnParams) <- isFunctionDeclaration mtHead args -> do
           rhsExpr <- rhsMultiTermToSimala rhs
-          mkFunction (toSimalaName fnName) (fmap toSimalaName fnParams) (TermExpr rhsExpr)
+          mkFunctionTerm (toSimalaName fnName) (fmap toSimalaName fnParams) (TermExpr rhsExpr)
       | Just (var, selectors) <- isAssignment mtHead args -> do
           rhsExpr <- rhsMultiTermToSimala rhs
-          mkAssignment (toSimalaName var) (fmap toSimalaName selectors) rhsExpr
+          mkAssignmentTerm (toSimalaName var) (fmap toSimalaName selectors) rhsExpr
       | otherwise -> throwError $ "relationalPredicateToSimala: Unsupported " <> show lhs
     [] -> throwError "empty lhs"
   RnConstraint lhs predicate rhs -> do
@@ -311,7 +332,7 @@ relationalPredicateToSimala = \case
       TermApp fnName fnParams -> do
         fnExpr <- assertSingletonList "RnNary.TermApp" rhsExprs
         rhsExpr <- assertTermExpr fnExpr
-        mkFunction fnName fnParams (TermExpr rhsExpr)
+        mkFunctionTerm fnName fnParams (TermExpr rhsExpr)
       TermLetIn{} -> throwError "Not implemented yet"
       TermAttribute name selectors Simala.Undefined -> do
         someRhs <- assertSingletonList "RnNary.TermAttribute" rhsExprs
@@ -382,7 +403,7 @@ lhsMultiTermToSimala (mtHead : rest)
   | Just (fnName, fnParams) <- isFunctionDeclaration mtHead rest =
       mkFunctionHead (toSimalaName fnName) (fmap toSimalaName fnParams)
   | Just (varName, selectors) <- isProjection mtHead rest =
-      mkRecordAssignment (toSimalaName varName) (fmap toSimalaName selectors)
+      mkRecordAssignmentTerm (toSimalaName varName) (fmap toSimalaName selectors)
 lhsMultiTermToSimala xs = throwError $ "lhsMultiTermToSimala: unsupported pattern: " <> show xs
 
 rhsMultiTermToSimala :: (MonadError String m) => RnMultiTerm -> m Simala.Expr
@@ -570,66 +591,67 @@ assertAttributeHasSelectors expr = throwError $ "Unexpected term, expected non-e
 mkUndefinedTerm :: SimalaTerm
 mkUndefinedTerm = TermExpr Simala.Undefined
 
-mkAssignment :: (MonadError String m) => Simala.Name -> [Simala.Name] -> Simala.Expr -> m SimalaTerm
-mkAssignment name selectors expr = pure $ TermAttribute name selectors expr
+mkAssignmentTerm :: (MonadError String m) => Simala.Name -> [Simala.Name] -> Simala.Expr -> m SimalaTerm
+mkAssignmentTerm name selectors expr = pure $ TermAttribute name selectors expr
 
 mkFunctionHead :: (MonadError String m) => Simala.Name -> [Simala.Name] -> m SimalaTerm
 mkFunctionHead funcName funcParams = pure $ TermApp funcName funcParams
 
-mkRecordAssignment :: (MonadError String m) => Simala.Name -> NE.NonEmpty Simala.Name -> m SimalaTerm
-mkRecordAssignment varName selectors =
+mkRecordAssignmentTerm :: (MonadError String m) => Simala.Name -> NE.NonEmpty Simala.Name -> m SimalaTerm
+mkRecordAssignmentTerm varName selectors =
   pure $
     TermAttribute
       varName
       (NE.toList selectors)
       Simala.Undefined
 
-mkTransparentLetIn :: (MonadError String m) => Simala.Name -> SimalaTerm -> m SimalaTerm
-mkTransparentLetIn var term = do
+mkLetInTerm :: (MonadError String m) => Simala.Name -> SimalaTerm -> m SimalaTerm
+mkLetInTerm var term = do
   body <- assertTermExpr term
   pure $ TermLetIn Simala.Transparent var body
 
-mkFunction :: (MonadError String m) => Simala.Name -> [Simala.Name] -> SimalaTerm -> m SimalaTerm
-mkFunction fnName fnParams term = do
+mkFunctionTerm :: (MonadError String m) => Simala.Name -> [Simala.Name] -> SimalaTerm -> m SimalaTerm
+mkFunctionTerm fnName fnParams term = do
   body <- assertTermExpr term
-  pure $ TermFunction fnName fnParams body
+  pure $ TermFunction Simala.Transparent fnName fnParams body
 
-mkIfThenElse :: (MonadError String m) => Simala.Expr -> SimalaTerm -> SimalaTerm -> m SimalaTerm
-mkIfThenElse b (TermLetIn t1 name1 expr1) (TermLetIn t2 name2 expr2) = do
+mkIfThenElseTerm :: (MonadError String m) => Simala.Expr -> SimalaTerm -> SimalaTerm -> m SimalaTerm
+mkIfThenElseTerm b (TermLetIn t1 name1 expr1) (TermLetIn t2 name2 expr2) = do
   assertEquals t1 t2
   assertEquals name1 name2
   ifThenElseTerm <- fixedArity Simala.IfThenElse 3 [b, expr1, expr2]
   ifThenElse <- assertTermExpr ifThenElseTerm
   pure $ TermLetIn t1 name1 ifThenElse
-mkIfThenElse b (TermLetIn t1 name1 body1) (TermExpr expr) = do
+mkIfThenElseTerm b (TermLetIn t1 name1 body1) (TermExpr expr) = do
   ifThenElseTerm <- fixedArity Simala.IfThenElse 3 [b, body1, expr]
   ifThenElse <- assertTermExpr ifThenElseTerm
   pure $ TermLetIn t1 name1 ifThenElse
-mkIfThenElse b (TermAttribute name1 selectors1 expr1) (TermAttribute name2 selectors2 expr2) = do
+mkIfThenElseTerm b (TermAttribute name1 selectors1 expr1) (TermAttribute name2 selectors2 expr2) = do
   assertEquals name1 name2
   assertEquals selectors1 selectors2
   ifThenElseTerm <- fixedArity Simala.IfThenElse 3 [b, expr1, expr2]
   ifThenElse <- assertTermExpr ifThenElseTerm
   pure $ TermAttribute name1 selectors1 ifThenElse
-mkIfThenElse b (TermAttribute name1 selectors1 expr1) (TermExpr expr2) = do
+mkIfThenElseTerm b (TermAttribute name1 selectors1 expr1) (TermExpr expr2) = do
   ifThenElseTerm <- fixedArity Simala.IfThenElse 3 [b, expr1, expr2]
   ifThenElse <- assertTermExpr ifThenElseTerm
   pure $ TermAttribute name1 selectors1 ifThenElse
-mkIfThenElse b (TermFunction fnName1 fnParams1 expr1) (TermFunction fnName2 fnParams2 expr2) = do
+mkIfThenElseTerm b (TermFunction t1 fnName1 fnParams1 expr1) (TermFunction t2 fnName2 fnParams2 expr2) = do
+  assertEquals t1 t2
   assertEquals fnName1 fnName2
   assertEquals fnParams1 fnParams2
   ifThenElseTerm <- fixedArity Simala.IfThenElse 3 [b, expr1, expr2]
   ifThenElse <- assertTermExpr ifThenElseTerm
-  pure $ TermFunction fnName1 fnParams1 ifThenElse
-mkIfThenElse b (TermFunction fnName1 fnParams1 expr1) (TermExpr expr) = do
+  pure $ TermFunction t1 fnName1 fnParams1 ifThenElse
+mkIfThenElseTerm b (TermFunction t fnName1 fnParams1 expr1) (TermExpr expr) = do
   ifThenElseTerm <- fixedArity Simala.IfThenElse 3 [b, expr1, expr]
   ifThenElse <- assertTermExpr ifThenElseTerm
-  pure $ TermFunction fnName1 fnParams1 ifThenElse
-mkIfThenElse b (TermExpr expr1) (TermExpr expr2) = do
+  pure $ TermFunction t fnName1 fnParams1 ifThenElse
+mkIfThenElseTerm b (TermExpr expr1) (TermExpr expr2) = do
   ifThenElseTerm <- fixedArity Simala.IfThenElse 3 [b, expr1, expr2]
   ifThenElse <- assertTermExpr ifThenElseTerm
   pure $ TermExpr ifThenElse
-mkIfThenElse _b term1 term2 =
+mkIfThenElseTerm _b term1 term2 =
   throwError $
     "Can't wrap terms in an if-then-else.\nFirst term: "
       <> show term1
@@ -654,6 +676,14 @@ mkLetIn :: Simala.Transparency -> Simala.Name -> Simala.Expr -> Simala.Expr -> S
 mkLetIn transparency name rhs nextExpr =
   Simala.Let transparency name rhs nextExpr
 
+mkFunction :: Simala.Transparency -> Simala.Name -> [Simala.Name] -> Simala.Expr -> Simala.Expr -> Simala.Expr
+mkFunction transparency name params rhs nextExpr =
+  mkLetIn transparency name (mkFunctionDecl transparency params rhs) nextExpr
+
+mkFunctionDecl :: Simala.Transparency -> [Simala.Name] -> Simala.Expr -> Simala.Expr
+mkFunctionDecl transparency params rhs =
+  Simala.Fun transparency params rhs
+
 buildRecordUpdate :: NonEmpty Simala.Name -> Simala.Expr -> Simala.Expr
 buildRecordUpdate names expr = go $ NE.toList names
  where
@@ -702,7 +732,7 @@ WHERE
 |]
 
 -- >>> transpileRulePure exampleWithOneOf
--- "let f_g_4 = fun(v_d_0) => let v_y_1 = if v_d_0 > 0 then e_green_2 else if b_OTHERWISE_5 then e_red_3 else undefined in v_y_1"
+-- "let f_g_4 = fun (v_d_0) => let v_y_1 = if v_d_0 > 0 then e_green_2 else if b_OTHERWISE_5 then e_red_3 else undefined in v_y_1 in undefined"
 
 exampleWithOneOf :: String
 exampleWithOneOf =
@@ -977,11 +1007,11 @@ debugTranspileRule ruleSrc = do
     Left err -> putStrLn err
     Right rnRule -> do
       TL.putStrLn $ Pretty.pShow rnRule
-      simalaTerms <- runExceptT $ ruleToSimala rnRule
+      simalaTerms <- runExceptT $ transpile [rnRule]
       case simalaTerms of
         Left err -> putStrLn err
         Right expr -> do
-          Text.putStrLn $ "Expr: " <> render expr
+          Text.putStrLn $ "Expr: " <> Simala.render expr
 
 transpileRulePure :: String -> Text
 transpileRulePure ruleSrc =
@@ -992,18 +1022,10 @@ transpileRulePure ruleSrc =
     case res of
       Left err -> Text.pack err
       Right rnRule -> do
-        case runExcept $ ruleToSimala rnRule of
+        case runExcept $ transpile [rnRule] of
           Left err -> Text.pack err
           Right expr ->
-            render expr
-
-render :: SimalaTerm -> Text
-render (TermExpr e) = Simala.render e
-render (TermLetIn _ name var) = "let " <> Simala.render name <> " = " <> Simala.render var
-render (TermApp name params) = Simala.render name <> "(" <> Text.intercalate ", " (fmap Simala.render params) <> ")"
-render (TermFunction name params expr) = "let " <> Simala.render name <> " = fun(" <> Text.intercalate ", " (fmap Simala.render params) <> ") => " <> Simala.render expr
-render (TermAttribute name [] expr) = "let " <> Simala.render name <> " = " <> Simala.render expr
-render (TermAttribute name (x : xs) expr) = "let " <> Simala.render name <> " = " <> Simala.render (buildRecordUpdate (x :| xs) expr)
+            Simala.render expr
 
 run :: String -> Either String LS.Rule
 run = fmap Parser.transRule . Parser.pRule . Parser.myLexer
diff --git a/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs b/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
index 791be995b..aeffda8f6 100644
--- a/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
+++ b/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
@@ -14,6 +14,7 @@ import LS.Renamer qualified as Renamer
 import LS.Rule
 import LS.XPile.Logging (pShowNoColorS)
 import LS.XPile.Simala.Transpile qualified as Simala
+import Simala.Expr.Render qualified as Simala
 import System.FilePath
 import Test.Hspec
 import Test.Hspec.Golden
@@ -29,6 +30,7 @@ spec = do
     describe "real-world" do
       realWorldTests
 
+basicTests :: Spec
 basicTests = do
   transpilerTest
     "function-id"
@@ -169,6 +171,7 @@ basicTests = do
       DECIDE y's z IS 5
       |]
 
+realWorldTests :: Spec
 realWorldTests = do
   transpilerTest
     "rodents-and-vermin"
@@ -216,7 +219,7 @@ transpilerTest outputName ruleString = it outputName $
               , pShowNoColorS scope
               ]
           (Right rnRule, _) -> do
-            case runExcept (Simala.ruleToSimala rnRule) of
+            case runExcept (Simala.transpile [rnRule]) of
               Left err -> "Failed transpilation:\n" <> err
               Right simala -> Text.unpack $ Simala.render simala
 

From ef26ec54f61b1ac6460d3aa4014aefc71a673908 Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Fri, 9 Aug 2024 18:06:25 +0200
Subject: [PATCH 19/44] Introduce Transpiler monad

---
 lib/haskell/natural4/src/LS/Renamer.hs        |  2 +-
 .../natural4/src/LS/XPile/Simala/Transpile.hs | 84 +++++++++----------
 .../natural4/test/LS/XPile/SimalaSpec.hs      |  2 +-
 3 files changed, 44 insertions(+), 44 deletions(-)

diff --git a/lib/haskell/natural4/src/LS/Renamer.hs b/lib/haskell/natural4/src/LS/Renamer.hs
index 747666255..2eac9b91f 100644
--- a/lib/haskell/natural4/src/LS/Renamer.hs
+++ b/lib/haskell/natural4/src/LS/Renamer.hs
@@ -157,7 +157,7 @@ data RnRelationalPredicate
 -- ----------------------------------------------------------------------------
 
 newtype Renamer a = Renamer {runRenamer :: ExceptT String (State Scope) a}
-  deriving (Functor, Applicative, Monad)
+  deriving newtype (Functor, Applicative, Monad)
   deriving newtype (MonadState Scope, MonadError String)
 
 type Unique = Int
diff --git a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
index aff7ace32..ae27e2702 100644
--- a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
+++ b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedRecordDot #-}
@@ -24,7 +23,6 @@ import Optics
 import Text.Pretty.Simple qualified as Pretty
 
 import LS.Renamer
-import LS.Renamer qualified as Renamer
 import LS.Rule qualified as LS
 import LS.Types qualified as LS
 import TextuaL4.ParTextuaL qualified as Parser
@@ -101,12 +99,16 @@ data SimalaTerm
 -- Top Level transpilation functions and test helpers
 -- ----------------------------------------------------------------------------
 
-transpile :: (MonadError String m) => [RnRule] -> m Simala.Expr
+newtype Transpiler a = Transpiler {runTranspiler :: Except String a}
+  deriving newtype (Functor, Applicative, Monad)
+  deriving newtype (MonadError String)
+
+transpile :: [RnRule] -> Transpiler Simala.Expr
 transpile rules = do
   simalaTerms <- Maybe.catMaybes <$> traverse ruleToSimala rules
   combineSimalaTerms Simala.Undefined simalaTerms
 
-combineSimalaTerms :: (MonadError String m) => Simala.Expr -> [SimalaTerm] -> m Simala.Expr
+combineSimalaTerms :: Simala.Expr -> [SimalaTerm] -> Transpiler Simala.Expr
 combineSimalaTerms inExpr [] = pure inExpr
 combineSimalaTerms inExpr (TermLetIn t name expr : terms) = do
   restOfInExpr <- combineSimalaTerms inExpr terms
@@ -121,7 +123,7 @@ combineSimalaTerms _inExpr _terms = do
 -- Main translation helpers
 -- ----------------------------------------------------------------------------
 
-ruleToSimala :: (MonadError String m) => RnRule -> m (Maybe SimalaTerm)
+ruleToSimala :: RnRule -> Transpiler (Maybe SimalaTerm)
 ruleToSimala (TypeDecl _typedecl) =
   -- Simala doesn't need to declare types, we can use anonymously.
   -- We assume that ach rule has been typechecked already, so we don't need to
@@ -168,7 +170,7 @@ ruleToSimala (Hornlike hornlike) = do
 --
 -- ----------------------------------------------------------------------------
 
-hornClausesToSimala :: (MonadError String m) => [RnHornClause] -> m [SimalaTerm]
+hornClausesToSimala :: [RnHornClause] -> Transpiler [SimalaTerm]
 hornClausesToSimala clauses = do
   simalaTerms <- traverse processClause clauses
   let
@@ -193,7 +195,7 @@ groupClauses simalaTerms = do
   compareClauseHeads (TermAttribute name1 _ _) (TermAttribute name2 _ _) = name1 == name2
   compareClauseHeads _ _ = False
 
-foldInSubTerms :: forall m. (MonadError String m) => SimalaTerm -> [SimalaTerm] -> m SimalaTerm
+foldInSubTerms :: SimalaTerm -> [SimalaTerm] -> Transpiler SimalaTerm
 foldInSubTerms top [] = pure top
 foldInSubTerms top (x : xs) = case top of
   TermExpr{} -> throwError $ "foldInSubTerms: Unexpected SimalaTerm: " <> show top
@@ -208,7 +210,7 @@ foldInSubTerms top (x : xs) = case top of
     fnExprWithLocals <- linearLetIns fnExpr (x :| xs)
     pure $ TermFunction t fnName fnParams fnExprWithLocals
  where
-  linearLetIns :: Simala.Expr -> NonEmpty SimalaTerm -> m Simala.Expr
+  linearLetIns :: Simala.Expr -> NonEmpty SimalaTerm -> Transpiler Simala.Expr
   linearLetIns finalExpr terms = do
     inExpr <- case NE.tail terms of
       [] -> pure finalExpr
@@ -226,12 +228,12 @@ foldInSubTerms top (x : xs) = case top of
         pure $ mkLetIn t fnName (Simala.Fun Simala.Transparent fnParams fnExpr) inExpr
 
 -- | Given a collection of groups, merge each group into a single expression.
-mergeGroups :: (Traversable t, MonadError String m) => t (NonEmpty (SimalaTerm, Maybe Simala.Expr)) -> m (t SimalaTerm)
+mergeGroups :: (Traversable t) => t (NonEmpty (SimalaTerm, Maybe Simala.Expr)) -> Transpiler (t SimalaTerm)
 mergeGroups simalaTermGroups = do
   traverse mergeGroups' simalaTermGroups
 
 -- | Do the heavy lifting of how to actually merge multiple clauses into a single term.
-mergeGroups' :: (MonadError String m) => NonEmpty (SimalaTerm, Maybe Simala.Expr) -> m SimalaTerm
+mergeGroups' :: NonEmpty (SimalaTerm, Maybe Simala.Expr) -> Transpiler SimalaTerm
 mergeGroups' terms@((TermAttribute name _ _, _) :| _) = do
   attributeTerms <-
     traverse
@@ -250,7 +252,7 @@ mergeGroups' ((term, Just g) :| (n : ns)) = do
   elseBranch <- mergeGroups' (n :| ns)
   mkIfThenElseTerm g term elseBranch
 
-mergeAttributes :: (MonadError String m) => Simala.Name -> NonEmpty ([Simala.Name], Simala.Expr, Maybe Simala.Expr) -> m SimalaTerm
+mergeAttributes :: Simala.Name -> NonEmpty ([Simala.Name], Simala.Expr, Maybe Simala.Expr) -> Transpiler SimalaTerm
 mergeAttributes name terms = do
   let
     initSelectors = NE.head terms ^. _1
@@ -305,7 +307,7 @@ toIfThenElseChain ((expr, guard) :| terms) =
 -- Transpilation
 -- ----------------------------------------------------------------------------
 
-relationalPredicateToSimala :: (MonadError String m) => RnRelationalPredicate -> m SimalaTerm
+relationalPredicateToSimala :: RnRelationalPredicate -> Transpiler SimalaTerm
 relationalPredicateToSimala = \case
   RnRelationalTerm lhs -> lhsMultiTermToSimala lhs
   RnConstraint lhs LS.RPis rhs -> case lhs of
@@ -351,14 +353,14 @@ relationalPredicateToSimala = \case
     (_builtin, builder) <- predRelToBuiltIn predicate
     builder [lhsExpr, rhsSimalaExpr]
 
-predicateToSimala :: (MonadError String m) => LS.RPRel -> [RnRelationalPredicate] -> m SimalaTerm
+predicateToSimala :: LS.RPRel -> [RnRelationalPredicate] -> Transpiler SimalaTerm
 predicateToSimala rp params' = do
   params <- traverse relationalPredicateToSimala params'
   exprs <- traverse assertTermExpr params
   (_, builder) <- predRelToBuiltIn rp
   builder exprs
 
-predRelToBuiltIn :: (MonadError String m) => LS.RPRel -> m (Simala.Builtin, [Simala.Expr] -> m SimalaTerm)
+predRelToBuiltIn :: LS.RPRel -> Transpiler (Simala.Builtin, [Simala.Expr] -> Transpiler SimalaTerm)
 predRelToBuiltIn rp = case rp of
   LS.RPis -> throwError $ "Unsupported relational predicate: " <> show rp
   LS.RPhas -> throwError $ "Unsupported relational predicate: " <> show rp
@@ -383,21 +385,21 @@ predRelToBuiltIn rp = case rp of
   LS.RPmap -> throwError $ "Unsupported relational predicate: " <> show rp
   LS.RPTC _temporal -> throwError $ "Unsupported relational predicate: " <> show rp
 
-flexibleArity :: (MonadError String m) => Simala.Builtin -> [Simala.Expr] -> m SimalaTerm
+flexibleArity :: Simala.Builtin -> [Simala.Expr] -> Transpiler SimalaTerm
 flexibleArity b params = do
   pure $ TermExpr $ Simala.Builtin b params
 
-atLeastArity :: (MonadError String m) => Simala.Builtin -> Int -> [Simala.Expr] -> m SimalaTerm
+atLeastArity :: Simala.Builtin -> Int -> [Simala.Expr] -> Transpiler SimalaTerm
 atLeastArity b arity params' = do
   params <- assertLengthAtLeast arity params'
   pure $ TermExpr $ Simala.Builtin b params
 
-fixedArity :: (MonadError String m) => Simala.Builtin -> Int -> [Simala.Expr] -> m SimalaTerm
+fixedArity :: Simala.Builtin -> Int -> [Simala.Expr] -> Transpiler SimalaTerm
 fixedArity b arity params' = do
   params <- assertLength arity params'
   pure $ TermExpr $ Simala.Builtin b params
 
-lhsMultiTermToSimala :: (MonadError String m) => RnMultiTerm -> m SimalaTerm
+lhsMultiTermToSimala :: RnMultiTerm -> Transpiler SimalaTerm
 lhsMultiTermToSimala [rnExpr] = pure $ TermExpr $ exprToSimala rnExpr
 lhsMultiTermToSimala (mtHead : rest)
   | Just (fnName, fnParams) <- isFunctionDeclaration mtHead rest =
@@ -406,14 +408,14 @@ lhsMultiTermToSimala (mtHead : rest)
       mkRecordAssignmentTerm (toSimalaName varName) (fmap toSimalaName selectors)
 lhsMultiTermToSimala xs = throwError $ "lhsMultiTermToSimala: unsupported pattern: " <> show xs
 
-rhsMultiTermToSimala :: (MonadError String m) => RnMultiTerm -> m Simala.Expr
+rhsMultiTermToSimala :: RnMultiTerm -> Transpiler Simala.Expr
 rhsMultiTermToSimala [rnExpr] = pure $ exprToSimala rnExpr
 rhsMultiTermToSimala (mtHead : rest)
   | Just _fnName <- isFunction mtHead = pure $ Simala.App (exprToSimala mtHead) $ fmap exprToSimala rest
   | Just (varName, selectors) <- isProjection mtHead rest = pure $ applySelectors (toSimalaName varName) (fmap toSimalaName selectors)
 rhsMultiTermToSimala exprs = throwError $ "Unhandled rhs: " <> show exprs
 
-boolStructToSimala :: (MonadError String m) => RnBoolStructR -> m Simala.Expr
+boolStructToSimala :: RnBoolStructR -> Transpiler Simala.Expr
 boolStructToSimala = \case
   AA.Leaf relationalPredicate -> do
     simalaTerm <- relationalPredicateToSimala relationalPredicate
@@ -517,11 +519,11 @@ rnNameTypePrefix = \case
 -- Assertion helpers
 -- ----------------------------------------------------------------------------
 
-assertIsTermAttribute :: (MonadError String m) => SimalaTerm -> m (Simala.Name, [Simala.Name], Simala.Expr)
+assertIsTermAttribute :: SimalaTerm -> Transpiler (Simala.Name, [Simala.Name], Simala.Expr)
 assertIsTermAttribute (TermAttribute name selectors expr) = pure (name, selectors, expr)
 assertIsTermAttribute term = throwError $ "Expected TermAttribute but got: " <> show term
 
-assertSingletonList :: (MonadError String m) => String -> [a] -> m a
+assertSingletonList :: String -> [a] -> Transpiler a
 assertSingletonList _errMsg [a] = pure a
 assertSingletonList errMsg as =
   throwError $
@@ -530,7 +532,7 @@ assertSingletonList errMsg as =
       <> show (length as)
       <> " elements"
 
-assertLengthAtLeast :: (MonadError String m) => Int -> [a] -> m [a]
+assertLengthAtLeast :: Int -> [a] -> Transpiler [a]
 assertLengthAtLeast l as =
   let
     len = length as
@@ -544,7 +546,7 @@ assertLengthAtLeast l as =
             <> show (length as)
       else pure as
 
-assertLength :: (MonadError String m) => Int -> [a] -> m [a]
+assertLength :: Int -> [a] -> Transpiler [a]
 assertLength l as =
   let
     len = length as
@@ -558,28 +560,28 @@ assertLength l as =
             <> show (length as)
       else pure as
 
-assertNonEmpty :: (MonadError String m) => [a] -> m (NonEmpty a)
+assertNonEmpty :: [a] -> Transpiler (NonEmpty a)
 assertNonEmpty [] = throwError "Expected non-empty list"
 assertNonEmpty (x : xs) = pure $ x :| xs
 
-assertPredicateIsMultiTerm :: (MonadError String m) => String -> RnRelationalPredicate -> m RnMultiTerm
+assertPredicateIsMultiTerm :: String -> RnRelationalPredicate -> Transpiler RnMultiTerm
 assertPredicateIsMultiTerm _errMsg (RnRelationalTerm mt) = pure mt
 assertPredicateIsMultiTerm errMsg predicate = throwError $ errMsg <> "\nExpected RnRelationalTerm but got: " <> show predicate
 
-assertTermExpr :: (MonadError String m) => SimalaTerm -> m Simala.Expr
+assertTermExpr :: SimalaTerm -> Transpiler Simala.Expr
 assertTermExpr (TermExpr expr) = pure expr
 assertTermExpr term = throwError $ "Expected TermExpr but got: " <> show term
 
-assertEquals :: (MonadError String m, Eq a, Show a) => a -> a -> m ()
+assertEquals :: (Eq a, Show a) => a -> a -> Transpiler ()
 assertEquals a b
   | a == b = pure ()
   | otherwise = throwError $ "Provided args are not equal: " <> show a <> " /= " <> show b
 
-assertIsRecord :: (MonadError String m) => Simala.Expr -> m (Simala.Row Simala.Expr)
+assertIsRecord :: Simala.Expr -> Transpiler (Simala.Row Simala.Expr)
 assertIsRecord (Simala.Record row) = pure row
 assertIsRecord simalaExpr = throwError $ "Unexpected simala expression, expected Record but got: " <> show simalaExpr
 
-assertAttributeHasSelectors :: (MonadError String m) => SimalaTerm -> m (NonEmpty Simala.Name, Simala.Expr)
+assertAttributeHasSelectors :: SimalaTerm -> Transpiler (NonEmpty Simala.Name, Simala.Expr)
 assertAttributeHasSelectors (TermAttribute _ (x : xs) expr) = pure (x :| xs, expr)
 assertAttributeHasSelectors expr@(TermAttribute _ [] _) = throwError $ "Unexpected term, expected non-empty TermAttribute but got: " <> show expr
 assertAttributeHasSelectors expr = throwError $ "Unexpected term, expected non-empty TermAttribute but got: " <> show expr
@@ -591,13 +593,13 @@ assertAttributeHasSelectors expr = throwError $ "Unexpected term, expected non-e
 mkUndefinedTerm :: SimalaTerm
 mkUndefinedTerm = TermExpr Simala.Undefined
 
-mkAssignmentTerm :: (MonadError String m) => Simala.Name -> [Simala.Name] -> Simala.Expr -> m SimalaTerm
+mkAssignmentTerm :: Simala.Name -> [Simala.Name] -> Simala.Expr -> Transpiler SimalaTerm
 mkAssignmentTerm name selectors expr = pure $ TermAttribute name selectors expr
 
-mkFunctionHead :: (MonadError String m) => Simala.Name -> [Simala.Name] -> m SimalaTerm
+mkFunctionHead :: Simala.Name -> [Simala.Name] -> Transpiler SimalaTerm
 mkFunctionHead funcName funcParams = pure $ TermApp funcName funcParams
 
-mkRecordAssignmentTerm :: (MonadError String m) => Simala.Name -> NE.NonEmpty Simala.Name -> m SimalaTerm
+mkRecordAssignmentTerm :: Simala.Name -> NE.NonEmpty Simala.Name -> Transpiler SimalaTerm
 mkRecordAssignmentTerm varName selectors =
   pure $
     TermAttribute
@@ -605,17 +607,17 @@ mkRecordAssignmentTerm varName selectors =
       (NE.toList selectors)
       Simala.Undefined
 
-mkLetInTerm :: (MonadError String m) => Simala.Name -> SimalaTerm -> m SimalaTerm
+mkLetInTerm :: Simala.Name -> SimalaTerm -> Transpiler SimalaTerm
 mkLetInTerm var term = do
   body <- assertTermExpr term
   pure $ TermLetIn Simala.Transparent var body
 
-mkFunctionTerm :: (MonadError String m) => Simala.Name -> [Simala.Name] -> SimalaTerm -> m SimalaTerm
+mkFunctionTerm :: Simala.Name -> [Simala.Name] -> SimalaTerm -> Transpiler SimalaTerm
 mkFunctionTerm fnName fnParams term = do
   body <- assertTermExpr term
   pure $ TermFunction Simala.Transparent fnName fnParams body
 
-mkIfThenElseTerm :: (MonadError String m) => Simala.Expr -> SimalaTerm -> SimalaTerm -> m SimalaTerm
+mkIfThenElseTerm :: Simala.Expr -> SimalaTerm -> SimalaTerm -> Transpiler SimalaTerm
 mkIfThenElseTerm b (TermLetIn t1 name1 expr1) (TermLetIn t2 name2 expr2) = do
   assertEquals t1 t2
   assertEquals name1 name2
@@ -691,7 +693,7 @@ buildRecordUpdate names expr = go $ NE.toList names
   go (x : xs) = Simala.Record [(x, go xs)]
 
 -- TODO: what was I thinking?
-mergeRecordUpdates :: (MonadError String m) => [Simala.Row Simala.Expr] -> m Simala.Expr
+mergeRecordUpdates :: [Simala.Row Simala.Expr] -> Transpiler Simala.Expr
 mergeRecordUpdates xs = worker xs
  where
   worker rows = do
@@ -704,9 +706,8 @@ mergeRecordUpdates xs = worker xs
     pure $ Simala.Record simpleRows
 
   simplifyRow ::
-    (MonadError String m) =>
     NonEmpty (Simala.Name, Simala.Expr) ->
-    m (Simala.Name, Simala.Expr)
+    Transpiler (Simala.Name, Simala.Expr)
   simplifyRow ((n, expr) :| []) = pure (n, expr)
   simplifyRow rows@((n, _) :| _) = do
     let
@@ -1007,8 +1008,7 @@ debugTranspileRule ruleSrc = do
     Left err -> putStrLn err
     Right rnRule -> do
       TL.putStrLn $ Pretty.pShow rnRule
-      simalaTerms <- runExceptT $ transpile [rnRule]
-      case simalaTerms of
+      case runExcept $ runTranspiler $ transpile [rnRule] of
         Left err -> putStrLn err
         Right expr -> do
           Text.putStrLn $ "Expr: " <> Simala.render expr
@@ -1022,7 +1022,7 @@ transpileRulePure ruleSrc =
     case res of
       Left err -> Text.pack err
       Right rnRule -> do
-        case runExcept $ transpile [rnRule] of
+        case runExcept $ runTranspiler $ transpile [rnRule] of
           Left err -> Text.pack err
           Right expr ->
             Simala.render expr
diff --git a/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs b/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
index aeffda8f6..bd83379ed 100644
--- a/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
+++ b/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
@@ -219,7 +219,7 @@ transpilerTest outputName ruleString = it outputName $
               , pShowNoColorS scope
               ]
           (Right rnRule, _) -> do
-            case runExcept (Simala.transpile [rnRule]) of
+            case runExcept (Simala.runTranspiler $ Simala.transpile [rnRule]) of
               Left err -> "Failed transpilation:\n" <> err
               Right simala -> Text.unpack $ Simala.render simala
 

From 609189f77394498caea2fa167257169697050f00 Mon Sep 17 00:00:00 2001
From: Andres Loeh <andres@well-typed.com>
Date: Mon, 12 Aug 2024 10:57:00 +0200
Subject: [PATCH 20/44] Comments / discussion / refactoring.

---
 .../natural4/src/LS/XPile/Simala/Transpile.hs | 35 ++++++++++---------
 1 file changed, 19 insertions(+), 16 deletions(-)

diff --git a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
index ae27e2702..7d222c529 100644
--- a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
+++ b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
@@ -30,6 +30,7 @@ import TextuaL4.Transform qualified as Parser
 
 import AnyAll.BoolStruct qualified as AA
 import Data.Maybe qualified as Maybe
+import Simala.Expr.Parser (mkIfThenElse)
 import Simala.Expr.Render qualified as Simala
 import Simala.Expr.Type qualified as Simala
 
@@ -125,8 +126,8 @@ combineSimalaTerms _inExpr _terms = do
 
 ruleToSimala :: RnRule -> Transpiler (Maybe SimalaTerm)
 ruleToSimala (TypeDecl _typedecl) =
-  -- Simala doesn't need to declare types, we can use anonymously.
-  -- We assume that ach rule has been typechecked already, so we don't need to
+  -- Simala doesn't need to declare types, we can use them anonymously.
+  -- We assume that each rule has been typechecked already, so we don't need to
   -- re-check anything.
   --
   pure Nothing
@@ -178,6 +179,7 @@ hornClausesToSimala clauses = do
   simplifiedSimalaTerms <- mergeGroups groupedSimalaTerms
   pure simplifiedSimalaTerms
  where
+  processClause :: RnHornClause -> Transpiler (SimalaTerm, Maybe Simala.Expr)
   processClause clause = do
     hornHead <- relationalPredicateToSimala clause.rnHcHead
     hornBody <- traverse boolStructToSimala clause.rnHcBody
@@ -195,6 +197,9 @@ groupClauses simalaTerms = do
   compareClauseHeads (TermAttribute name1 _ _) (TermAttribute name2 _ _) = name1 == name2
   compareClauseHeads _ _ = False
 
+-- | Takes the translation of local variables in where clauses and turns
+-- them into a Simala-let underneath potential lambdas.
+--
 foldInSubTerms :: SimalaTerm -> [SimalaTerm] -> Transpiler SimalaTerm
 foldInSubTerms top [] = pure top
 foldInSubTerms top (x : xs) = case top of
@@ -252,6 +257,9 @@ mergeGroups' ((term, Just g) :| (n : ns)) = do
   elseBranch <- mergeGroups' (n :| ns)
   mkIfThenElseTerm g term elseBranch
 
+-- | Tries to merge multiple assignments for fields of a single record
+-- into a single record construction.
+--
 mergeAttributes :: Simala.Name -> NonEmpty ([Simala.Name], Simala.Expr, Maybe Simala.Expr) -> Transpiler SimalaTerm
 mergeAttributes name terms = do
   let
@@ -283,6 +291,7 @@ mergeAttributes name terms = do
       treeRows <- mergeRecordUpdates recordRows
       pure $ TermLetIn Simala.Transparent name treeRows
  where
+  reduceAttrPaths :: NonEmpty (NonEmpty Simala.Name, Simala.Expr, Maybe Simala.Expr) -> (NonEmpty Simala.Name, Simala.Expr)
   reduceAttrPaths attrs =
     let
       attrPath = NE.head attrs ^. _1
@@ -617,41 +626,35 @@ mkFunctionTerm fnName fnParams term = do
   body <- assertTermExpr term
   pure $ TermFunction Simala.Transparent fnName fnParams body
 
+-- Andres: needs documentation
 mkIfThenElseTerm :: Simala.Expr -> SimalaTerm -> SimalaTerm -> Transpiler SimalaTerm
 mkIfThenElseTerm b (TermLetIn t1 name1 expr1) (TermLetIn t2 name2 expr2) = do
   assertEquals t1 t2
   assertEquals name1 name2
-  ifThenElseTerm <- fixedArity Simala.IfThenElse 3 [b, expr1, expr2]
-  ifThenElse <- assertTermExpr ifThenElseTerm
+  let ifThenElse = mkIfThenElse b expr1 expr2
   pure $ TermLetIn t1 name1 ifThenElse
 mkIfThenElseTerm b (TermLetIn t1 name1 body1) (TermExpr expr) = do
-  ifThenElseTerm <- fixedArity Simala.IfThenElse 3 [b, body1, expr]
-  ifThenElse <- assertTermExpr ifThenElseTerm
+  let ifThenElse = mkIfThenElse b body1 expr
   pure $ TermLetIn t1 name1 ifThenElse
 mkIfThenElseTerm b (TermAttribute name1 selectors1 expr1) (TermAttribute name2 selectors2 expr2) = do
   assertEquals name1 name2
   assertEquals selectors1 selectors2
-  ifThenElseTerm <- fixedArity Simala.IfThenElse 3 [b, expr1, expr2]
-  ifThenElse <- assertTermExpr ifThenElseTerm
+  let ifThenElse = mkIfThenElse b expr1 expr2
   pure $ TermAttribute name1 selectors1 ifThenElse
 mkIfThenElseTerm b (TermAttribute name1 selectors1 expr1) (TermExpr expr2) = do
-  ifThenElseTerm <- fixedArity Simala.IfThenElse 3 [b, expr1, expr2]
-  ifThenElse <- assertTermExpr ifThenElseTerm
+  let ifThenElse = mkIfThenElse b expr1 expr2
   pure $ TermAttribute name1 selectors1 ifThenElse
 mkIfThenElseTerm b (TermFunction t1 fnName1 fnParams1 expr1) (TermFunction t2 fnName2 fnParams2 expr2) = do
   assertEquals t1 t2
   assertEquals fnName1 fnName2
   assertEquals fnParams1 fnParams2
-  ifThenElseTerm <- fixedArity Simala.IfThenElse 3 [b, expr1, expr2]
-  ifThenElse <- assertTermExpr ifThenElseTerm
+  let ifThenElse = mkIfThenElse b expr1 expr2
   pure $ TermFunction t1 fnName1 fnParams1 ifThenElse
 mkIfThenElseTerm b (TermFunction t fnName1 fnParams1 expr1) (TermExpr expr) = do
-  ifThenElseTerm <- fixedArity Simala.IfThenElse 3 [b, expr1, expr]
-  ifThenElse <- assertTermExpr ifThenElseTerm
+  let ifThenElse = mkIfThenElse b expr1 expr
   pure $ TermFunction t fnName1 fnParams1 ifThenElse
 mkIfThenElseTerm b (TermExpr expr1) (TermExpr expr2) = do
-  ifThenElseTerm <- fixedArity Simala.IfThenElse 3 [b, expr1, expr2]
-  ifThenElse <- assertTermExpr ifThenElseTerm
+  let ifThenElse = mkIfThenElse b expr1 expr2
   pure $ TermExpr ifThenElse
 mkIfThenElseTerm _b term1 term2 =
   throwError $

From 6102fbd834031a7cbe242af323bc99d6985f1c1a Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Mon, 12 Aug 2024 13:06:48 +0200
Subject: [PATCH 21/44] Implement lexical scoping rules for Renamer

---
 lib/haskell/natural4/src/LS/Renamer.hs        |  58 ++++++-
 .../natural4/src/LS/XPile/Simala/Transpile.hs |   1 -
 lib/haskell/natural4/test/LS/RenamerSpec.hs   |  49 +++---
 .../natural4/test/LS/XPile/SimalaSpec.hs      |  34 +++-
 .../golden/renamer/id-func-multi.expected     | 164 ++++++++++++++++++
 .../xpile/simala/calls-another.expected       |   1 +
 .../eragon-book-with-attributes.expected      |   2 +-
 .../golden/xpile/simala/eragon-book.expected  |   2 +-
 .../golden/xpile/simala/function-id.expected  |   2 +-
 .../simala/function-nested-selector.expected  |   2 +-
 .../xpile/simala/function-record.expected     |   2 +-
 .../xpile/simala/function-selector.expected   |   2 +-
 .../golden/xpile/simala/function-sum.expected |   2 +-
 .../function-with-attributes-1.expected       |   2 +-
 ...on-with-attributes-conditionals-1.expected |   2 +-
 ...on-with-attributes-conditionals-2.expected |   2 +-
 .../function-with-conditionals-1.expected     |   2 +-
 .../function-with-conditionals-2.expected     |   2 +-
 .../function-with-conditionals-3.expected     |   2 +-
 .../golden/xpile/simala/functions.expected    |   1 +
 .../simala/giveth-record-nested.expected      |   2 +-
 .../xpile/simala/giveth-record.expected       |   2 +-
 .../golden/xpile/simala/giveth.expected       |   2 +-
 .../no-giveth-adhoc-y-attribute.expected      |   2 +-
 .../xpile/simala/no-giveth-adhoc-y.expected   |   2 +-
 25 files changed, 288 insertions(+), 56 deletions(-)
 create mode 100644 lib/haskell/natural4/test/testdata/golden/renamer/id-func-multi.expected
 create mode 100644 lib/haskell/natural4/test/testdata/golden/xpile/simala/calls-another.expected
 create mode 100644 lib/haskell/natural4/test/testdata/golden/xpile/simala/functions.expected

diff --git a/lib/haskell/natural4/src/LS/Renamer.hs b/lib/haskell/natural4/src/LS/Renamer.hs
index 2eac9b91f..38e7ffd1c 100644
--- a/lib/haskell/natural4/src/LS/Renamer.hs
+++ b/lib/haskell/natural4/src/LS/Renamer.hs
@@ -214,6 +214,13 @@ unionScopeTable tbl1 tbl2 =
     , _stFunction = Map.union tbl1._stFunction tbl2._stFunction
     }
 
+differenceScopeTable :: ScopeTable -> ScopeTable -> ScopeTable
+differenceScopeTable tbl1 tbl2 =
+  ScopeTable
+    { _stVariables = Map.difference tbl1._stVariables tbl2._stVariables
+    , _stFunction = Map.difference tbl1._stFunction tbl2._stFunction
+    }
+
 makeFieldsNoPrefix 'Scope
 makeFieldsNoPrefix 'ScopeTable
 
@@ -314,6 +321,16 @@ lookupFunction :: RnName -> Renamer (Maybe FuncInfo)
 lookupFunction rnFnName =
   use (scScopeTable % stFunction % at rnFnName)
 
+withLocalScopeTable :: Renamer a -> Renamer (a, ScopeTable)
+withLocalScopeTable act = do
+  orig <- use scScopeTable
+  a <- act
+  origWithNew <- use scScopeTable
+  pure (a, origWithNew `differenceScopeTable` orig)
+
+withLocalScopeTable_ :: Renamer a -> Renamer ScopeTable
+withLocalScopeTable_ = fmap snd . withLocalScopeTable
+
 -- ----------------------------------------------------------------------------
 -- Helper types for local context
 -- ----------------------------------------------------------------------------
@@ -360,10 +377,34 @@ renameRuleTopLevel' rule =
   in
     (fmap head resE, scope)
 
+renameRules :: [Rule] -> (Either String [RnRule], Scope)
+renameRules rule =
+  let
+    (resE, scope) = State.runState (Except.runExceptT (runRenamer $ renamer rule)) emptyScope
+  in
+    (resE, scope)
+
 renamer :: [Rule] -> Renamer [RnRule]
 renamer rules = do
-  traverse_ scanRule rules
-  traverse renameRule rules
+  rulesWithLocalDefs <-
+    traverse
+      ( \r -> do
+          prev <- use scScopeTable
+          exportedScope <- scanRule r
+          fullRuleScope <- use scScopeTable
+          assign' scScopeTable (prev `unionScopeTable` exportedScope)
+          pure (r, fullRuleScope)
+      )
+      rules
+  traverse
+    ( \(r, ruleScope) -> do
+        orig <- use scScopeTable
+        modifying' scScopeTable (`unionScopeTable` ruleScope)
+        rnRule <- renameRule r
+        assign' scScopeTable orig
+        pure rnRule
+    )
+    rulesWithLocalDefs
 
 -- ----------------------------------------------------------------------------
 -- Resolve functions and their respective arities
@@ -376,12 +417,13 @@ renamer rules = do
 -- 1. Functions and variables in the head of 'HornClauses'.
 -- 2. Names declared in 'GIVETH' clauses.
 -- 3. Types and selectors defined via 'DEFINE'
-scanRule :: Rule -> Renamer ()
+scanRule :: Rule -> Renamer ScopeTable
 scanRule rule@Rule.Hornlike{} = do
-  scanGiveths rule.giveth
-  -- TODO: givens should only be scanned for 'scanHornClause' and then removed again.
   scanGivens rule.given
-  traverse_ scanHornClause rule.clauses
+  exports <- withLocalScopeTable_ $ do
+    scanGiveths rule.giveth
+    traverse_ scanHornClause rule.clauses
+  pure exports
 scanRule r@Rule.Regulative{} = throwError $ "scanRule: Unsupported rule: " <> show r
 scanRule r@Rule.Constitutive{} = throwError $ "scanRule: Unsupported rule: " <> show r
 scanRule rule@Rule.TypeDecl{} = do
@@ -390,6 +432,8 @@ scanRule rule@Rule.TypeDecl{} = do
   scanGivens rule.given
   traverse_ scanRule rule.has
   scanTypeDeclName rule.name
+  typeScope <- use scScopeTable
+  pure typeScope
 scanRule r@Rule.Scenario{} = throwError $ "scanRule: Unsupported rule: " <> show r
 scanRule r@Rule.DefNameAlias{} = throwError $ "scanRule: Unsupported rule: " <> show r
 scanRule r@Rule.DefTypically{} = throwError $ "scanRule: Unsupported rule: " <> show r
@@ -444,7 +488,6 @@ scanDecideHeadClause = \case
 --
 -- Note, to be recognized as a function, variables must have been specified by 'GIVEN'
 -- clauses and the function name must be unbound in its current scope.
--- TODO: scope checking is currently a WIP.
 --
 -- Additionally, we recognize the following forms:
 --
@@ -603,6 +646,7 @@ scanTypeDeclName mtexprs = do
 renameLocalRules :: [Rule] -> Renamer ([RnRule], ScopeTable)
 renameLocalRules localRules = do
   origScopeTable <- use scScopeTable
+  -- TODO: fix like in renamer
   traverse_ scanRule localRules
   localExports <- use scScopeTable
   rnLocalRules <- traverse renameRule localRules
diff --git a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
index 7d222c529..b5c468550 100644
--- a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
+++ b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
@@ -673,7 +673,6 @@ applySelectors name selectors =
 
 -- | Apply a selector to the given expression.
 --
--- TODO: this should only succeed if 'RnName.rnNameType == RnSelector'.
 applySelector :: Simala.Expr -> Simala.Name -> Simala.Expr
 applySelector expr proj = Simala.Project expr proj
 
diff --git a/lib/haskell/natural4/test/LS/RenamerSpec.hs b/lib/haskell/natural4/test/LS/RenamerSpec.hs
index 93a880357..211178956 100644
--- a/lib/haskell/natural4/test/LS/RenamerSpec.hs
+++ b/lib/haskell/natural4/test/LS/RenamerSpec.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
+{-# OPTIONS_GHC -Wall #-}
 
 module LS.RenamerSpec (spec) where
 
@@ -16,10 +17,11 @@ import LS.Renamer qualified as Renamer
 import LS.Rule
 import LS.Types
 import System.FilePath ((<.>), (</>))
-import Test.Hspec (Spec, describe, it, shouldBe)
+import Test.Hspec (Example (Arg), Spec, SpecWith, describe, it, shouldBe)
 import Test.Hspec.Golden
 import Text.Pretty.Simple (pShowNoColor)
 import Text.RawString.QQ (r)
+import Data.String.Interpolate
 import TextuaL4.LexTextuaL (Token)
 import TextuaL4.ParTextuaL (myLexer, pListRule, pRule)
 import TextuaL4.Transform
@@ -42,7 +44,6 @@ spec :: Spec
 spec = do
   describe "Renamer" do
     test'
-      "Book Attributes"
       "decide-with-attributes"
       [r|
         GIVEN d DECIDE g d IS y
@@ -51,31 +52,37 @@ spec = do
             y's book IS red OTHERWISE
         |]
     test'
-      "Id Function"
       "id-func"
       [r|
         GIVEN x
         DECIDE id x IS x
         |]
+    test'
+      "id-func-multi"
+      [i|
+GIVEN x
+DECIDE f x IS x
+§
+GIVEN x
+DECIDE g x IS x
+        |]
  where
-  test rule = test' rule rule
-
-  test' desc fname ruleSource = do
-    it desc $ do
-      let
-        Right rules = runList ruleSource
-        rnRules =
-          State.evalState
-            (Except.runExceptT (Renamer.runRenamer $ Renamer.renamer rules))
-            Renamer.emptyScope
-      goldenGeneric fname rnRules
-
-type Err = Either String
-type ParseFun a = [Token] -> Err a
-type Verbosity = Int
-
-run :: String -> Either String Rule
-run = fmap transRule . pRule . myLexer
+  test' :: String -> String -> SpecWith (Arg (Golden TL.Text))
+  test' fname ruleSource = do
+    it fname $
+      goldenGeneric fname $
+        case runList ruleSource of
+          Left err -> Left $ "Failed to parse program:\n" <> ruleSource <> "\n" <> err
+          Right rules ->
+            let
+              parse =
+                State.evalState
+                  (Except.runExceptT (Renamer.runRenamer $ Renamer.renamer rules))
+                  Renamer.emptyScope
+            in
+              case parse of
+                Left err -> Left $ "Failed to rename program: " <> err
+                Right rnRules -> Right rnRules
 
 runList :: String -> Either String [Rule]
 runList = fmap (fmap transRule) . pListRule . myLexer
diff --git a/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs b/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
index bd83379ed..ceb19852a 100644
--- a/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
+++ b/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
@@ -24,9 +24,10 @@ import TextuaL4.Transform qualified as Parser
 
 spec :: Spec
 spec = do
-  describe "rule transpilation" do
+  describe "Simala" do
     describe "basic" do
       basicTests
+      multiRuleTests
     describe "real-world" do
       realWorldTests
 
@@ -171,6 +172,24 @@ basicTests = do
       DECIDE y's z IS 5
       |]
 
+
+multiRuleTests :: Spec
+multiRuleTests = describe "multi-rules" do
+  transpilerTest
+    "calls-functions"
+    [i|
+      GIVEN x DECIDE f x IS x
+      §
+      GIVEN x DECIDE g x IS f x
+      |]
+  transpilerTest
+    "functions"
+    [i|
+      GIVEN x DECIDE f x IS x
+      §
+      GIVEN x DECIDE g x IS x
+      |]
+
 realWorldTests :: Spec
 realWorldTests = do
   transpilerTest
@@ -205,10 +224,10 @@ IF
 transpilerTest :: String -> String -> SpecWith (Arg (Golden TL.Text))
 transpilerTest outputName ruleString = it outputName $
   goldenGeneric outputName $
-    case run ruleString of
+    case runList ruleString of
       Left err -> "Failed to parse program:\n" <> ruleString
-      Right rule -> do
-        case Renamer.renameRuleTopLevel' rule of
+      Right rules -> do
+        case Renamer.renameRules rules of
           (Left err, scope) ->
             unlines
               [ "Renaming failed for program:"
@@ -218,8 +237,8 @@ transpilerTest outputName ruleString = it outputName $
               , "Scope table:"
               , pShowNoColorS scope
               ]
-          (Right rnRule, _) -> do
-            case runExcept (Simala.runTranspiler $ Simala.transpile [rnRule]) of
+          (Right rnRules, _) -> do
+            case runExcept (Simala.runTranspiler $ Simala.transpile rnRules) of
               Left err -> "Failed transpilation:\n" <> err
               Right simala -> Text.unpack $ Simala.render simala
 
@@ -237,8 +256,5 @@ goldenGeneric name output_ =
  where
   testPath = "test" </> "testdata" </> "golden" </> "xpile" </> "simala" </> name
 
-run :: String -> Either String Rule
-run = fmap Parser.transRule . Parser.pRule . Parser.myLexer
-
 runList :: String -> Either String [Rule]
 runList = fmap (fmap Parser.transRule) . Parser.pListRule . Parser.myLexer
diff --git a/lib/haskell/natural4/test/testdata/golden/renamer/id-func-multi.expected b/lib/haskell/natural4/test/testdata/golden/renamer/id-func-multi.expected
new file mode 100644
index 000000000..626333404
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/renamer/id-func-multi.expected
@@ -0,0 +1,164 @@
+Right
+    [ Hornlike
+        ( RnHornlike
+            { name =
+                [ RnExprName
+                    ( RnName
+                        { rnOccName = MTT "f" :| []
+                        , rnUniqueId = 1
+                        , rnNameType = RnFunction
+                        }
+                    )
+                , RnExprName
+                    ( RnName
+                        { rnOccName = MTT "x" :| []
+                        , rnUniqueId = 0
+                        , rnNameType = RnVariable
+                        }
+                    )
+                ]
+            , super = Nothing
+            , keyword = Decide
+            , given = Just
+                ( RnParamText
+                    { mkParamText = RnTypedMulti
+                        { rnTypedMultiExpr = RnExprName
+                            ( RnName
+                                { rnOccName = MTT "x" :| []
+                                , rnUniqueId = 0
+                                , rnNameType = RnVariable
+                                }
+                            ) :| []
+                        , rnTypedMultiTypeSig = Nothing
+                        } :| []
+                    }
+                )
+            , giveth = Nothing
+            , upon = Nothing
+            , clauses =
+                [ RnHornClause
+                    { rnHcHead = RnConstraint
+                        [ RnExprName
+                            ( RnName
+                                { rnOccName = MTT "f" :| []
+                                , rnUniqueId = 1
+                                , rnNameType = RnFunction
+                                }
+                            )
+                        , RnExprName
+                            ( RnName
+                                { rnOccName = MTT "x" :| []
+                                , rnUniqueId = 0
+                                , rnNameType = RnVariable
+                                }
+                            )
+                        ] RPis
+                        [ RnExprName
+                            ( RnName
+                                { rnOccName = MTT "x" :| []
+                                , rnUniqueId = 0
+                                , rnNameType = RnVariable
+                                }
+                            )
+                        ]
+                    , rnHcBody = Nothing
+                    }
+                ]
+            , rlabel = Nothing
+            , lsource = Nothing
+            , wwhere = []
+            , srcref = Just
+                ( SrcRef
+                    { url = "test/Spec"
+                    , short = "test/Spec"
+                    , srcrow = 1
+                    , srccol = 1
+                    , version = Nothing
+                    }
+                )
+            , defaults = []
+            , symtab = []
+            }
+        )
+    , Hornlike
+        ( RnHornlike
+            { name =
+                [ RnExprName
+                    ( RnName
+                        { rnOccName = MTT "g" :| []
+                        , rnUniqueId = 3
+                        , rnNameType = RnFunction
+                        }
+                    )
+                , RnExprName
+                    ( RnName
+                        { rnOccName = MTT "x" :| []
+                        , rnUniqueId = 2
+                        , rnNameType = RnVariable
+                        }
+                    )
+                ]
+            , super = Nothing
+            , keyword = Decide
+            , given = Just
+                ( RnParamText
+                    { mkParamText = RnTypedMulti
+                        { rnTypedMultiExpr = RnExprName
+                            ( RnName
+                                { rnOccName = MTT "x" :| []
+                                , rnUniqueId = 2
+                                , rnNameType = RnVariable
+                                }
+                            ) :| []
+                        , rnTypedMultiTypeSig = Nothing
+                        } :| []
+                    }
+                )
+            , giveth = Nothing
+            , upon = Nothing
+            , clauses =
+                [ RnHornClause
+                    { rnHcHead = RnConstraint
+                        [ RnExprName
+                            ( RnName
+                                { rnOccName = MTT "g" :| []
+                                , rnUniqueId = 3
+                                , rnNameType = RnFunction
+                                }
+                            )
+                        , RnExprName
+                            ( RnName
+                                { rnOccName = MTT "x" :| []
+                                , rnUniqueId = 2
+                                , rnNameType = RnVariable
+                                }
+                            )
+                        ] RPis
+                        [ RnExprName
+                            ( RnName
+                                { rnOccName = MTT "x" :| []
+                                , rnUniqueId = 2
+                                , rnNameType = RnVariable
+                                }
+                            )
+                        ]
+                    , rnHcBody = Nothing
+                    }
+                ]
+            , rlabel = Nothing
+            , lsource = Nothing
+            , wwhere = []
+            , srcref = Just
+                ( SrcRef
+                    { url = "test/Spec"
+                    , short = "test/Spec"
+                    , srcrow = 1
+                    , srccol = 1
+                    , version = Nothing
+                    }
+                )
+            , defaults = []
+            , symtab = []
+            }
+        )
+    ]
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/calls-another.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/calls-another.expected
new file mode 100644
index 000000000..c8c2c5155
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/calls-another.expected
@@ -0,0 +1 @@
+let f_f_1 = fun (v_x_0) => v_x_0 in let f_g_3 = fun (v_x_2) => f_f_1(v_x_2) in undefined
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/eragon-book-with-attributes.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/eragon-book-with-attributes.expected
index 724f8456b..ad0aa5431 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/eragon-book-with-attributes.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/eragon-book-with-attributes.expected
@@ -1 +1 @@
-let v_eragon_0 = let v_localVar_1 = {s_character_4 = {s_friend_7 = 'Ork,s_main_5 = 'Eragon,s_villain_6 = 'Galbatorix},s_size_3 = 512,s_title_2 = 'Eragon} in v_localVar_1
\ No newline at end of file
+let v_eragon_0 = let v_localVar_1 = {s_character_4 = {s_friend_7 = 'Ork,s_main_5 = 'Eragon,s_villain_6 = 'Galbatorix},s_size_3 = 512,s_title_2 = 'Eragon} in v_localVar_1 in undefined
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/eragon-book.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/eragon-book.expected
index 329d137a0..4f623247b 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/eragon-book.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/eragon-book.expected
@@ -1 +1 @@
-let v_eragon_0 = {s_character_3 = {s_friend_6 = 'Ork,s_main_4 = 'Eragon,s_villain_5 = 'Galbatorix},s_size_2 = 512,s_title_1 = 'Eragon}
\ No newline at end of file
+let v_eragon_0 = {s_character_3 = {s_friend_6 = 'Ork,s_main_4 = 'Eragon,s_villain_5 = 'Galbatorix},s_size_2 = 512,s_title_1 = 'Eragon} in undefined
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-id.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-id.expected
index 037027d4f..f0d384bb5 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-id.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-id.expected
@@ -1 +1 @@
-let f_id_1 = fun(v_x_0) => v_x_0
\ No newline at end of file
+let f_id_1 = fun (v_x_0) => v_x_0 in undefined
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-nested-selector.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-nested-selector.expected
index cb1024ce8..0b45ad9dc 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-nested-selector.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-nested-selector.expected
@@ -1 +1 @@
-let f_f_1 = fun(v_x_0) => v_x_0.s_y_2.s_z_3
\ No newline at end of file
+let f_f_1 = fun (v_x_0) => v_x_0.s_y_2.s_z_3 in undefined
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-record.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-record.expected
index b04d66419..ebf050b21 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-record.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-record.expected
@@ -1 +1 @@
-let f_g_1 = fun(v_d_0) => let v_y_2 = {s_book_3 = if v_d_0 > 0 then 'green else if b_OTHERWISE_4 then 'red else undefined} in v_y_2
\ No newline at end of file
+let f_g_1 = fun (v_d_0) => let v_y_2 = {s_book_3 = if v_d_0 > 0 then 'green else if b_OTHERWISE_4 then 'red else undefined} in v_y_2 in undefined
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-selector.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-selector.expected
index d760eefcc..081f261c0 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-selector.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-selector.expected
@@ -1 +1 @@
-let f_f_1 = fun(v_x_0) => v_x_0.s_z_2
\ No newline at end of file
+let f_f_1 = fun (v_x_0) => v_x_0.s_z_2 in undefined
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-sum.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-sum.expected
index 49f44b0d4..7df24734e 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-sum.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-sum.expected
@@ -1 +1 @@
-let f_sum3_1 = fun(v_x_0) => sum(v_x_0,v_x_0,v_x_0)
\ No newline at end of file
+let f_sum3_1 = fun (v_x_0) => sum(v_x_0,v_x_0,v_x_0) in undefined
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-1.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-1.expected
index 9b76bb02f..9b3f5748f 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-1.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-1.expected
@@ -1 +1 @@
-let f_f_1 = fun(v_x_0) => let v_y_2 = {s_p_4 = v_x_0 + v_x_0,s_z_3 = 0} in v_y_2
\ No newline at end of file
+let f_f_1 = fun (v_x_0) => let v_y_2 = {s_p_4 = v_x_0 + v_x_0,s_z_3 = 0} in v_y_2 in undefined
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-conditionals-1.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-conditionals-1.expected
index 17028ac0c..b7f5dea8f 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-conditionals-1.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-conditionals-1.expected
@@ -1 +1 @@
-let f_f_1 = fun(v_x_0) => let v_y_2 = {s_z_3 = if v_x_0 > 3 then 5 else undefined} in v_y_2
\ No newline at end of file
+let f_f_1 = fun (v_x_0) => let v_y_2 = {s_z_3 = if v_x_0 > 3 then 5 else undefined} in v_y_2 in undefined
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-conditionals-2.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-conditionals-2.expected
index 5f258df35..ee09363ae 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-conditionals-2.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-conditionals-2.expected
@@ -1 +1 @@
-let f_f_1 = fun(v_x_0) => let v_y_2 = {s_p_4 = if v_x_0 > 5 then v_x_0 else if b_OTHERWISE_5 then v_x_0 + v_x_0 else undefined,s_z_3 = if v_x_0 > 3 then 5 else if b_OTHERWISE_5 then 0 else undefined} in v_y_2
\ No newline at end of file
+let f_f_1 = fun (v_x_0) => let v_y_2 = {s_p_4 = if v_x_0 > 5 then v_x_0 else if b_OTHERWISE_5 then v_x_0 + v_x_0 else undefined,s_z_3 = if v_x_0 > 3 then 5 else if b_OTHERWISE_5 then 0 else undefined} in v_y_2 in undefined
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-1.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-1.expected
index 358aaed2b..a292c1520 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-1.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-1.expected
@@ -1 +1 @@
-let f_f_1 = fun(v_x_0) => if v_x_0 > 0 then 1 else if b_OTHERWISE_2 then 0 else if v_x_0 < 0 then 2 else undefined
\ No newline at end of file
+let f_f_1 = fun (v_x_0) => if v_x_0 > 0 then 1 else if b_OTHERWISE_2 then 0 else if v_x_0 < 0 then 2 else undefined in undefined
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-2.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-2.expected
index 365946cc1..34b12ad2d 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-2.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-2.expected
@@ -1 +1 @@
-let f_f_1 = fun(v_x_0) => if v_x_0 > 0 then 1 else if b_OTHERWISE_2 then 0 else undefined
\ No newline at end of file
+let f_f_1 = fun (v_x_0) => if v_x_0 > 0 then 1 else if b_OTHERWISE_2 then 0 else undefined in undefined
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-3.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-3.expected
index dce6d7e6b..cf0f7cebb 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-3.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-3.expected
@@ -1 +1 @@
-let f_f_1 = fun(v_x_0) => if v_x_0 > 0 then 1 else 0
\ No newline at end of file
+let f_f_1 = fun (v_x_0) => if v_x_0 > 0 then 1 else 0 in undefined
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/functions.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/functions.expected
new file mode 100644
index 000000000..aeea5b5f1
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/functions.expected
@@ -0,0 +1 @@
+let f_f_1 = fun (v_x_0) => v_x_0 in let f_g_3 = fun (v_x_2) => v_x_2 in undefined
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth-record-nested.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth-record-nested.expected
index 047266c8f..562a37d52 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth-record-nested.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth-record-nested.expected
@@ -1 +1 @@
-let v_y_0 = {s_a_1 = {s_b_2 = {s_c_3 = {s_z_4 = 5}}}}
\ No newline at end of file
+let v_y_0 = {s_a_1 = {s_b_2 = {s_c_3 = {s_z_4 = 5}}}} in undefined
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth-record.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth-record.expected
index d734fd83e..93dc6029f 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth-record.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth-record.expected
@@ -1 +1 @@
-let v_y_0 = {s_z_1 = 5}
\ No newline at end of file
+let v_y_0 = {s_z_1 = 5} in undefined
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth.expected
index 8d5862886..6b3978e79 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth.expected
@@ -1 +1 @@
-let v_x_0 = let v_y_1 = 5 in v_y_1
\ No newline at end of file
+let v_x_0 = let v_y_1 = 5 in v_y_1 in undefined
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/no-giveth-adhoc-y-attribute.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/no-giveth-adhoc-y-attribute.expected
index d734fd83e..93dc6029f 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/no-giveth-adhoc-y-attribute.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/no-giveth-adhoc-y-attribute.expected
@@ -1 +1 @@
-let v_y_0 = {s_z_1 = 5}
\ No newline at end of file
+let v_y_0 = {s_z_1 = 5} in undefined
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/no-giveth-adhoc-y.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/no-giveth-adhoc-y.expected
index 5437efa4f..c1853c8c1 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/no-giveth-adhoc-y.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/no-giveth-adhoc-y.expected
@@ -1 +1 @@
-let v_y_0 = 5
\ No newline at end of file
+let v_y_0 = 5 in undefined
\ No newline at end of file

From 0404c2850932db199aaedaf393071b86e8e5cba9 Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Mon, 12 Aug 2024 15:20:45 +0200
Subject: [PATCH 22/44] Clean up renamer and simala functions

---
 lib/haskell/natural4/src/LS/Renamer.hs        | 112 ++++++++---------
 .../natural4/src/LS/XPile/Simala/Transpile.hs | 113 +++++++++---------
 lib/haskell/natural4/test/LS/RenamerSpec.hs   |  21 +---
 .../natural4/test/LS/XPile/SimalaSpec.hs      |  14 ++-
 .../xpile/simala/calls-functions.expected     |   1 +
 5 files changed, 121 insertions(+), 140 deletions(-)
 create mode 100644 lib/haskell/natural4/test/testdata/golden/xpile/simala/calls-functions.expected

diff --git a/lib/haskell/natural4/src/LS/Renamer.hs b/lib/haskell/natural4/src/LS/Renamer.hs
index 38e7ffd1c..d39a7ad75 100644
--- a/lib/haskell/natural4/src/LS/Renamer.hs
+++ b/lib/haskell/natural4/src/LS/Renamer.hs
@@ -166,7 +166,7 @@ type Unique = Int
 type OccName = NonEmpty LS.MTExpr
 
 data FuncInfo = FuncInfo
-  { funcArity :: (Int, Int)
+  { _funcArity :: (Int, Int)
   -- ^ Arity of a function. The first component means how many parameters
   -- are allowed before the function, the second component how many parameters
   -- are allowed afterwards.
@@ -185,13 +185,6 @@ data Scope = Scope
   }
   deriving (Eq, Ord, Show)
 
-data BindingSite
-  = WhereClause
-  | GivenClause
-  | DecideClause
-  | GivethClause
-  deriving (Eq, Ord, Show)
-
 -- | A 'ScopeTable' keeps tab on the variables and functions that occur in a
 -- program.
 --
@@ -223,6 +216,7 @@ differenceScopeTable tbl1 tbl2 =
 
 makeFieldsNoPrefix 'Scope
 makeFieldsNoPrefix 'ScopeTable
+makeFieldsNoPrefix 'FuncInfo
 
 emptyScopeTable :: ScopeTable
 emptyScopeTable =
@@ -238,9 +232,6 @@ emptyScope =
     , _scUniqueSupply = 0
     }
 
-prefixScope :: RuleName -> Scope -> Scope
-prefixScope = undefined
-
 newUnique :: Renamer Unique
 newUnique = do
   u <- use scUniqueSupply
@@ -290,6 +281,8 @@ lookupOrInsertName occName nameType =
               <> " but expected: "
               <> show (rnNameType name)
 
+-- | Insert an occurrence name into the current 'ScopeTable'.
+-- The new 'OccName' will overwrite (shadow?) any existing names.
 insertName :: OccName -> RnNameType -> Renamer RnName
 insertName occName nameType = do
   n <- newUnique
@@ -308,6 +301,7 @@ insertName occName nameType = do
     (Just rnName)
   pure rnName
 
+-- | Insert an function meta information into the current 'ScopeTable'.
 insertFunction :: RnName -> FuncInfo -> Renamer ()
 insertFunction rnFnName funcInfo =
   assign'
@@ -321,15 +315,19 @@ lookupFunction :: RnName -> Renamer (Maybe FuncInfo)
 lookupFunction rnFnName =
   use (scScopeTable % stFunction % at rnFnName)
 
-withLocalScopeTable :: Renamer a -> Renamer (a, ScopeTable)
-withLocalScopeTable act = do
+-- | Execute a 'Renamer' action, but record which 'RnName's and 'FuncInfo'
+-- were introduced during this action.
+--
+-- Note, this operation is rather expensive, so use it with caution!
+recordScopeTable :: Renamer a -> Renamer (a, ScopeTable)
+recordScopeTable act = do
   orig <- use scScopeTable
   a <- act
   origWithNew <- use scScopeTable
   pure (a, origWithNew `differenceScopeTable` orig)
 
-withLocalScopeTable_ :: Renamer a -> Renamer ScopeTable
-withLocalScopeTable_ = fmap snd . withLocalScopeTable
+recordScopeTable_ :: Renamer a -> Renamer ScopeTable
+recordScopeTable_ = fmap snd . recordScopeTable
 
 -- ----------------------------------------------------------------------------
 -- Helper types for local context
@@ -364,48 +362,19 @@ renameRuleTopLevel :: Rule -> IO ()
 renameRuleTopLevel rule = do
   TL.putStrLn $ Pretty.pShow rule
   let
-    (res, s) = renameRuleTopLevel' rule
+    (res, s) = runRenamerFor [rule]
   TL.putStrLn $ Pretty.pShow s
   case res of
     Left err -> putStrLn err
-    Right rnRule -> TL.putStrLn $ Pretty.pShow rnRule
-
-renameRuleTopLevel' :: Rule -> (Either String RnRule, Scope)
-renameRuleTopLevel' rule =
-  let
-    (resE, scope) = State.runState (Except.runExceptT (runRenamer $ renamer [rule])) emptyScope
-  in
-    (fmap head resE, scope)
+    Right rnRules -> TL.putStrLn $ Pretty.pShow $ head rnRules
 
-renameRules :: [Rule] -> (Either String [RnRule], Scope)
-renameRules rule =
+runRenamerFor :: (Traversable f) => f Rule -> (Either String (f RnRule), Scope)
+runRenamerFor rule =
   let
-    (resE, scope) = State.runState (Except.runExceptT (runRenamer $ renamer rule)) emptyScope
+    (resE, scope) = State.runState (Except.runExceptT (runRenamer $ renameRules rule)) emptyScope
   in
     (resE, scope)
 
-renamer :: [Rule] -> Renamer [RnRule]
-renamer rules = do
-  rulesWithLocalDefs <-
-    traverse
-      ( \r -> do
-          prev <- use scScopeTable
-          exportedScope <- scanRule r
-          fullRuleScope <- use scScopeTable
-          assign' scScopeTable (prev `unionScopeTable` exportedScope)
-          pure (r, fullRuleScope)
-      )
-      rules
-  traverse
-    ( \(r, ruleScope) -> do
-        orig <- use scScopeTable
-        modifying' scScopeTable (`unionScopeTable` ruleScope)
-        rnRule <- renameRule r
-        assign' scScopeTable orig
-        pure rnRule
-    )
-    rulesWithLocalDefs
-
 -- ----------------------------------------------------------------------------
 -- Resolve functions and their respective arities
 -- ----------------------------------------------------------------------------
@@ -417,10 +386,13 @@ renamer rules = do
 -- 1. Functions and variables in the head of 'HornClauses'.
 -- 2. Names declared in 'GIVETH' clauses.
 -- 3. Types and selectors defined via 'DEFINE'
+--
+-- 'scanRule' produces a 'ScopeTable' of items that are exported from this rule.
+-- Further, 'scanRule' may only *add* new names to the 'ScopeTable'.
 scanRule :: Rule -> Renamer ScopeTable
 scanRule rule@Rule.Hornlike{} = do
   scanGivens rule.given
-  exports <- withLocalScopeTable_ $ do
+  exports <- recordScopeTable_ $ do
     scanGiveths rule.giveth
     traverse_ scanHornClause rule.clauses
   pure exports
@@ -508,7 +480,7 @@ scanDecideMultiTerm mt = do
     fnDecl
       | Just (fnOccName, preArgs, postArgs) <- scanForFunctionDecl scopeTable fnDecl -> do
           rnF <- lookupOrInsertName fnOccName RnFunction
-          insertFunction rnF (FuncInfo{funcArity = (preArgs, postArgs)})
+          insertFunction rnF (FuncInfo{_funcArity = (preArgs, postArgs)})
     unknownPattern -> throwError $ "While scanning a multi term in a top-level DECIDE clause, we encountered an unsupported pattern: " <> show unknownPattern
 
 -- | Check whether this could be a function like structure.
@@ -636,30 +608,41 @@ scanTypeDeclName mtexprs = do
 -- Renamer passes
 -- ----------------------------------------------------------------------------
 
+-- |
 -- Lexical Scoping rules for hornlike rules:
 --
 -- GIVETH's are global
 -- GIVEN's are local
 -- DECIDE head term in "IS" clauses is global
 --
-
-renameLocalRules :: [Rule] -> Renamer ([RnRule], ScopeTable)
-renameLocalRules localRules = do
-  origScopeTable <- use scScopeTable
-  -- TODO: fix like in renamer
-  traverse_ scanRule localRules
-  localExports <- use scScopeTable
-  rnLocalRules <- traverse renameRule localRules
-  -- TODO: handle name conflicts
-  pure (rnLocalRules, origScopeTable `unionScopeTable` localExports)
+renameRules :: (Traversable f) => f Rule -> Renamer (f RnRule)
+renameRules rules = do
+  rulesWithLocalDefs <-
+    traverse
+      ( \r -> do
+          prev <- use scScopeTable
+          exportedScope <- scanRule r
+          fullRuleScope <- use scScopeTable
+          assign' scScopeTable (prev `unionScopeTable` exportedScope)
+          pure (r, fullRuleScope)
+      )
+      rules
+  traverse
+    ( \(r, ruleScope) -> do
+        orig <- use scScopeTable
+        modifying' scScopeTable (`unionScopeTable` ruleScope)
+        rnRule <- renameRule r
+        assign' scScopeTable orig
+        pure rnRule
+    )
+    rulesWithLocalDefs
 
 renameRule :: Rule -> Renamer RnRule
 renameRule rule@Rule.Hornlike{} = do
   super <- traverse renameTypeSignature rule.super
   given <- renameGivens rule.given
   giveth <- renameGiveths rule.giveth
-  (wwhere, scopeTableWithLocalDecls) <- renameLocalRules rule.wwhere
-  assign' scScopeTable scopeTableWithLocalDecls
+  wwhere <- renameLocalRules rule.wwhere
   upon <- renameUpons rule.upon
   defaults <- assertEmptyList rule.defaults
   symtab <- assertEmptyList rule.symtab
@@ -717,6 +700,9 @@ renameRule r@Rule.RegFulfilled{} = throwError $ "renameRule: Unsupported rule: "
 renameRule r@Rule.RegBreach{} = throwError $ "renameRule: Unsupported rule: " <> show r
 renameRule r@Rule.NotARule{} = throwError $ "renameRule: Unsupported rule: " <> show r
 
+renameLocalRules :: [Rule] -> Renamer [RnRule]
+renameLocalRules = renameRules
+
 renameTypeDeclName :: RuleName -> Renamer RnRuleName
 renameTypeDeclName mtexprs = do
   mt <- assertSingletonMultiTerm mtexprs
diff --git a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
index b5c468550..0868225a1 100644
--- a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
+++ b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
@@ -14,11 +14,13 @@ import Data.Foldable qualified as Foldable
 import Data.Function (on)
 import Data.List.NonEmpty (NonEmpty ((:|)))
 import Data.List.NonEmpty qualified as NE
+import Data.Maybe qualified as Maybe
 import Data.String.Interpolate
 import Data.Text (Text)
 import Data.Text qualified as Text
 import Data.Text.IO qualified as Text
 import Data.Text.Lazy.IO qualified as TL
+import Data.Tuple (Solo (..))
 import Optics
 import Text.Pretty.Simple qualified as Pretty
 
@@ -29,7 +31,7 @@ import TextuaL4.ParTextuaL qualified as Parser
 import TextuaL4.Transform qualified as Parser
 
 import AnyAll.BoolStruct qualified as AA
-import Data.Maybe qualified as Maybe
+
 import Simala.Expr.Parser (mkIfThenElse)
 import Simala.Expr.Render qualified as Simala
 import Simala.Expr.Type qualified as Simala
@@ -133,9 +135,11 @@ ruleToSimala (TypeDecl _typedecl) =
   pure Nothing
 ruleToSimala (Hornlike hornlike) = do
   terms <- hornClausesToSimala hornlike.clauses
-  term <- assertSingletonList "ruleToSimala" terms
-  subTerms <- traverse ruleToSimala hornlike.wwhere
-  Just <$> foldInSubTerms term (Maybe.catMaybes subTerms)
+  -- TODO: handle multiple GIVETH's.
+  -- Actually, handle GIVETHs at all.
+  mainDefinition <- assertSingletonList "ruleToSimala" terms
+  localDefinitions <- traverse ruleToSimala hornlike.wwhere
+  Just <$> addLocalDefinitions mainDefinition (Maybe.catMaybes localDefinitions)
 
 -- ----------------------------------------------------------------------------
 -- Post Processing of rule translation.
@@ -199,12 +203,11 @@ groupClauses simalaTerms = do
 
 -- | Takes the translation of local variables in where clauses and turns
 -- them into a Simala-let underneath potential lambdas.
---
-foldInSubTerms :: SimalaTerm -> [SimalaTerm] -> Transpiler SimalaTerm
-foldInSubTerms top [] = pure top
-foldInSubTerms top (x : xs) = case top of
-  TermExpr{} -> throwError $ "foldInSubTerms: Unexpected SimalaTerm: " <> show top
-  TermApp{} -> throwError $ "foldInSubTerms: Unexpected SimalaTerm: " <> show top
+addLocalDefinitions :: SimalaTerm -> [SimalaTerm] -> Transpiler SimalaTerm
+addLocalDefinitions top [] = pure top
+addLocalDefinitions top (x : xs) = case top of
+  TermExpr{} -> throwError $ "addLocalDefinitions: Unexpected SimalaTerm: " <> show top
+  TermApp{} -> throwError $ "addLocalDefinitions: Unexpected SimalaTerm: " <> show top
   TermLetIn t name expr -> do
     exprWithLocals <- linearLetIns expr (x :| xs)
     pure $ TermLetIn t name exprWithLocals
@@ -221,16 +224,16 @@ foldInSubTerms top (x : xs) = case top of
       [] -> pure finalExpr
       (a : as) -> linearLetIns finalExpr (a :| as)
     case NE.head terms of
-      TermApp{} -> throwError $ "linearLetIns: Unexpected SimalaTerm: " <> show top
+      TermApp{} -> throwError $ "linearLetIns: Unexpected SimalaTerm: " <> show (NE.head terms)
       TermLetIn t name expr -> do
         pure $ mkLetIn t name expr inExpr
-      TermExpr{} -> throwError $ "linearLetIns: Unexpected SimalaTerm: " <> show top
+      TermExpr{} -> throwError $ "linearLetIns: Unexpected SimalaTerm: " <> show (NE.head terms)
       TermAttribute name [] expr -> do
         pure $ mkLetIn Simala.Transparent name expr inExpr
       TermAttribute name (a : as) expr -> do
         pure $ mkLetIn Simala.Transparent name (buildRecordUpdate (a :| as) expr) inExpr
       TermFunction t fnName fnParams fnExpr -> do
-        pure $ mkLetIn t fnName (Simala.Fun Simala.Transparent fnParams fnExpr) inExpr
+        pure $ mkFunction t fnName fnParams fnExpr inExpr
 
 -- | Given a collection of groups, merge each group into a single expression.
 mergeGroups :: (Traversable t) => t (NonEmpty (SimalaTerm, Maybe Simala.Expr)) -> Transpiler (t SimalaTerm)
@@ -259,7 +262,6 @@ mergeGroups' ((term, Just g) :| (n : ns)) = do
 
 -- | Tries to merge multiple assignments for fields of a single record
 -- into a single record construction.
---
 mergeAttributes :: Simala.Name -> NonEmpty ([Simala.Name], Simala.Expr, Maybe Simala.Expr) -> Transpiler SimalaTerm
 mergeAttributes name terms = do
   let
@@ -286,7 +288,7 @@ mergeAttributes name terms = do
       let
         rowGroups = NE.groupWith (^. _1) rowTerms
         rowGroups' = fmap reduceAttrPaths rowGroups
-      rowExprs <- traverse (\(attrName, expr) -> pure $ buildRecordUpdate attrName expr) rowGroups'
+        rowExprs = fmap (\(attrName, expr) -> buildRecordUpdate attrName expr) rowGroups'
       recordRows <- traverse assertIsRecord rowExprs
       treeRows <- mergeRecordUpdates recordRows
       pure $ TermLetIn Simala.Transparent name treeRows
@@ -333,8 +335,7 @@ relationalPredicateToSimala = \case
     lhsSimalaExpr' <- lhsMultiTermToSimala lhs
     lhsSimalaExpr <- assertTermExpr lhsSimalaExpr'
     rhsSimalaExpr <- rhsMultiTermToSimala rhs
-    (_builtin, builder) <- predRelToBuiltIn predicate
-    builder [lhsSimalaExpr, rhsSimalaExpr]
+    predRelToBuiltIn predicate [lhsSimalaExpr, rhsSimalaExpr]
   RnNary LS.RPis (lhs : rhs) -> do
     multiTerm <- assertPredicateIsMultiTerm "relationalPredicateToSimala" lhs
     lhsSimalaTerm <- lhsMultiTermToSimala multiTerm
@@ -359,38 +360,36 @@ relationalPredicateToSimala = \case
     lhsTerm <- lhsMultiTermToSimala lhs
     lhsExpr <- assertTermExpr lhsTerm
     rhsSimalaExpr <- boolStructToSimala rhs
-    (_builtin, builder) <- predRelToBuiltIn predicate
-    builder [lhsExpr, rhsSimalaExpr]
+    predRelToBuiltIn predicate [lhsExpr, rhsSimalaExpr]
 
 predicateToSimala :: LS.RPRel -> [RnRelationalPredicate] -> Transpiler SimalaTerm
 predicateToSimala rp params' = do
   params <- traverse relationalPredicateToSimala params'
   exprs <- traverse assertTermExpr params
-  (_, builder) <- predRelToBuiltIn rp
-  builder exprs
+  predRelToBuiltIn rp exprs
 
-predRelToBuiltIn :: LS.RPRel -> Transpiler (Simala.Builtin, [Simala.Expr] -> Transpiler SimalaTerm)
-predRelToBuiltIn rp = case rp of
+predRelToBuiltIn :: LS.RPRel -> [Simala.Expr] -> Transpiler SimalaTerm
+predRelToBuiltIn rp exprs = case rp of
   LS.RPis -> throwError $ "Unsupported relational predicate: " <> show rp
   LS.RPhas -> throwError $ "Unsupported relational predicate: " <> show rp
-  LS.RPeq -> pure (Simala.Eq, fixedArity Simala.Eq 2)
-  LS.RPlt -> pure (Simala.Lt, fixedArity Simala.Lt 2)
-  LS.RPlte -> pure (Simala.Le, fixedArity Simala.Le 2)
-  LS.RPgt -> pure (Simala.Gt, fixedArity Simala.Gt 2)
-  LS.RPgte -> pure (Simala.Ge, fixedArity Simala.Ge 2)
+  LS.RPeq -> fixedArity Simala.Eq 2 exprs
+  LS.RPlt -> fixedArity Simala.Lt 2 exprs
+  LS.RPlte -> fixedArity Simala.Le 2 exprs
+  LS.RPgt -> fixedArity Simala.Gt 2 exprs
+  LS.RPgte -> fixedArity Simala.Ge 2 exprs
   LS.RPelem -> throwError $ "Unsupported relational predicate: " <> show rp
   LS.RPnotElem -> throwError $ "Unsupported relational predicate: " <> show rp
-  LS.RPnot -> pure (Simala.Not, fixedArity Simala.Not 1)
-  LS.RPand -> pure (Simala.And, flexibleArity Simala.And)
-  LS.RPor -> pure (Simala.Or, flexibleArity Simala.Or)
-  LS.RPsum -> pure (Simala.Sum, flexibleArity Simala.Sum)
-  LS.RPproduct -> pure (Simala.Product, flexibleArity Simala.Product)
-  LS.RPminus -> pure (Simala.Minus, fixedArity Simala.Minus 2)
-  LS.RPdivide -> pure (Simala.Divide, fixedArity Simala.Divide 2)
-  LS.RPmodulo -> pure (Simala.Modulo, fixedArity Simala.Modulo 2)
+  LS.RPnot -> fixedArity Simala.Not 1 exprs
+  LS.RPand -> flexibleArity Simala.And exprs
+  LS.RPor -> flexibleArity Simala.Or exprs
+  LS.RPsum -> flexibleArity Simala.Sum exprs
+  LS.RPproduct -> flexibleArity Simala.Product exprs
+  LS.RPminus -> fixedArity Simala.Minus 2 exprs
+  LS.RPdivide -> fixedArity Simala.Divide 2 exprs
+  LS.RPmodulo -> fixedArity Simala.Modulo 2 exprs
   LS.RPsubjectTo -> throwError $ "Unsupported relational predicate: " <> show rp
-  LS.RPmin -> pure (Simala.Maximum, atLeastArity Simala.Maximum 1)
-  LS.RPmax -> pure (Simala.Minimum, atLeastArity Simala.Minimum 1)
+  LS.RPmin -> atLeastArity Simala.Maximum 1 exprs
+  LS.RPmax -> atLeastArity Simala.Minimum 1 exprs
   LS.RPmap -> throwError $ "Unsupported relational predicate: " <> show rp
   LS.RPTC _temporal -> throwError $ "Unsupported relational predicate: " <> show rp
 
@@ -631,30 +630,37 @@ mkIfThenElseTerm :: Simala.Expr -> SimalaTerm -> SimalaTerm -> Transpiler Simala
 mkIfThenElseTerm b (TermLetIn t1 name1 expr1) (TermLetIn t2 name2 expr2) = do
   assertEquals t1 t2
   assertEquals name1 name2
-  let ifThenElse = mkIfThenElse b expr1 expr2
+  let
+    ifThenElse = mkIfThenElse b expr1 expr2
   pure $ TermLetIn t1 name1 ifThenElse
 mkIfThenElseTerm b (TermLetIn t1 name1 body1) (TermExpr expr) = do
-  let ifThenElse = mkIfThenElse b body1 expr
+  let
+    ifThenElse = mkIfThenElse b body1 expr
   pure $ TermLetIn t1 name1 ifThenElse
 mkIfThenElseTerm b (TermAttribute name1 selectors1 expr1) (TermAttribute name2 selectors2 expr2) = do
   assertEquals name1 name2
   assertEquals selectors1 selectors2
-  let ifThenElse = mkIfThenElse b expr1 expr2
+  let
+    ifThenElse = mkIfThenElse b expr1 expr2
   pure $ TermAttribute name1 selectors1 ifThenElse
 mkIfThenElseTerm b (TermAttribute name1 selectors1 expr1) (TermExpr expr2) = do
-  let ifThenElse = mkIfThenElse b expr1 expr2
+  let
+    ifThenElse = mkIfThenElse b expr1 expr2
   pure $ TermAttribute name1 selectors1 ifThenElse
 mkIfThenElseTerm b (TermFunction t1 fnName1 fnParams1 expr1) (TermFunction t2 fnName2 fnParams2 expr2) = do
   assertEquals t1 t2
   assertEquals fnName1 fnName2
   assertEquals fnParams1 fnParams2
-  let ifThenElse = mkIfThenElse b expr1 expr2
+  let
+    ifThenElse = mkIfThenElse b expr1 expr2
   pure $ TermFunction t1 fnName1 fnParams1 ifThenElse
 mkIfThenElseTerm b (TermFunction t fnName1 fnParams1 expr1) (TermExpr expr) = do
-  let ifThenElse = mkIfThenElse b expr1 expr
+  let
+    ifThenElse = mkIfThenElse b expr1 expr
   pure $ TermFunction t fnName1 fnParams1 ifThenElse
 mkIfThenElseTerm b (TermExpr expr1) (TermExpr expr2) = do
-  let ifThenElse = mkIfThenElse b expr1 expr2
+  let
+    ifThenElse = mkIfThenElse b expr1 expr2
   pure $ TermExpr ifThenElse
 mkIfThenElseTerm _b term1 term2 =
   throwError $
@@ -672,7 +678,6 @@ applySelectors name selectors =
   Foldable.foldl' applySelector (Simala.Var name) selectors
 
 -- | Apply a selector to the given expression.
---
 applySelector :: Simala.Expr -> Simala.Name -> Simala.Expr
 applySelector expr proj = Simala.Project expr proj
 
@@ -1000,15 +1005,15 @@ debugTranspileRule ruleSrc = do
   rule <- case run ruleSrc of
     Left err -> do
       putStrLn err
-      error ""
+      fail "translation failed"
     Right r -> pure r
   TL.putStrLn $ Pretty.pShow rule
   let
-    (res, s) = renameRuleTopLevel' rule
+    (res, s) = runRenamerFor $ MkSolo rule
   TL.putStrLn $ Pretty.pShow s
   case res of
     Left err -> putStrLn err
-    Right rnRule -> do
+    Right (MkSolo rnRule) -> do
       TL.putStrLn $ Pretty.pShow rnRule
       case runExcept $ runTranspiler $ transpile [rnRule] of
         Left err -> putStrLn err
@@ -1017,13 +1022,11 @@ debugTranspileRule ruleSrc = do
 
 transpileRulePure :: String -> Text
 transpileRulePure ruleSrc =
-  let
-    Right rule = run ruleSrc
-    (res, _s) = renameRuleTopLevel' rule
-  in
-    case res of
+  case run ruleSrc of
+    Left err -> Text.pack err
+    Right rule -> case fst $ runRenamerFor (MkSolo rule) of
       Left err -> Text.pack err
-      Right rnRule -> do
+      Right (MkSolo rnRule) -> do
         case runExcept $ runTranspiler $ transpile [rnRule] of
           Left err -> Text.pack err
           Right expr ->
diff --git a/lib/haskell/natural4/test/LS/RenamerSpec.hs b/lib/haskell/natural4/test/LS/RenamerSpec.hs
index 211178956..171ef43a0 100644
--- a/lib/haskell/natural4/test/LS/RenamerSpec.hs
+++ b/lib/haskell/natural4/test/LS/RenamerSpec.hs
@@ -6,24 +6,17 @@
 
 module LS.RenamerSpec (spec) where
 
-import Control.Monad.IO.Class
-import Control.Monad.Trans.Except qualified as Except
-import Control.Monad.Trans.State.Strict qualified as State
-import Data.Either (fromRight)
-import Data.List (intercalate)
+import Data.String.Interpolate
 import Data.Text.Lazy qualified as TL
 import Data.Text.Lazy.IO qualified as TL
 import LS.Renamer qualified as Renamer
 import LS.Rule
-import LS.Types
 import System.FilePath ((<.>), (</>))
-import Test.Hspec (Example (Arg), Spec, SpecWith, describe, it, shouldBe)
+import Test.Hspec (Example (Arg), Spec, SpecWith, describe, it)
 import Test.Hspec.Golden
 import Text.Pretty.Simple (pShowNoColor)
 import Text.RawString.QQ (r)
-import Data.String.Interpolate
-import TextuaL4.LexTextuaL (Token)
-import TextuaL4.ParTextuaL (myLexer, pListRule, pRule)
+import TextuaL4.ParTextuaL (myLexer, pListRule)
 import TextuaL4.Transform
 
 goldenGeneric :: (Show a) => String -> a -> Golden TL.Text
@@ -74,13 +67,7 @@ DECIDE g x IS x
         case runList ruleSource of
           Left err -> Left $ "Failed to parse program:\n" <> ruleSource <> "\n" <> err
           Right rules ->
-            let
-              parse =
-                State.evalState
-                  (Except.runExceptT (Renamer.runRenamer $ Renamer.renamer rules))
-                  Renamer.emptyScope
-            in
-              case parse of
+              case fst $ Renamer.runRenamerFor rules of
                 Left err -> Left $ "Failed to rename program: " <> err
                 Right rnRules -> Right rnRules
 
diff --git a/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs b/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
index ceb19852a..9bf7c0313 100644
--- a/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
+++ b/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
@@ -1,10 +1,10 @@
 {-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
+{-# OPTIONS_GHC -Wall #-}
 
 module LS.XPile.SimalaSpec (spec) where
 
-import Base (runExceptT)
 import Control.Monad.Trans.Except (runExcept)
 import Data.String.Interpolate
 import Data.Text qualified as Text
@@ -18,7 +18,6 @@ import Simala.Expr.Render qualified as Simala
 import System.FilePath
 import Test.Hspec
 import Test.Hspec.Golden
-import Text.Pretty.Simple qualified as Pretty
 import TextuaL4.ParTextuaL qualified as Parser
 import TextuaL4.Transform qualified as Parser
 
@@ -172,7 +171,6 @@ basicTests = do
       DECIDE y's z IS 5
       |]
 
-
 multiRuleTests :: Spec
 multiRuleTests = describe "multi-rules" do
   transpilerTest
@@ -225,9 +223,15 @@ transpilerTest :: String -> String -> SpecWith (Arg (Golden TL.Text))
 transpilerTest outputName ruleString = it outputName $
   goldenGeneric outputName $
     case runList ruleString of
-      Left err -> "Failed to parse program:\n" <> ruleString
+      Left err ->
+        unlines
+          [ "Failed to parse program:"
+          , ruleString
+          , "Err:"
+          , err
+          ]
       Right rules -> do
-        case Renamer.renameRules rules of
+        case Renamer.runRenamerFor rules of
           (Left err, scope) ->
             unlines
               [ "Renaming failed for program:"
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/calls-functions.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/calls-functions.expected
new file mode 100644
index 000000000..c8c2c5155
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/calls-functions.expected
@@ -0,0 +1 @@
+let f_f_1 = fun (v_x_0) => v_x_0 in let f_g_3 = fun (v_x_2) => f_f_1(v_x_2) in undefined
\ No newline at end of file

From 3341af0e9735f2c7af87b3e2ef82c96c42166c38 Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Mon, 12 Aug 2024 17:43:48 +0200
Subject: [PATCH 23/44] Fix function arity checks

---
 lib/haskell/natural4/src/LS/Renamer.hs        |  89 +++++++--
 .../natural4/src/LS/XPile/Simala/Transpile.hs |  25 ++-
 lib/haskell/natural4/test/LS/RenamerSpec.hs   |  48 +++++
 .../fail-id-func-multi-wrong-arity-1.expected |   1 +
 .../fail-id-func-multi-wrong-arity-2.expected |   1 +
 .../fail-id-func-multi-wrong-arity-3.expected | 178 ++++++++++++++++++
 .../fail-id-func-multi-wrong-arity-4.expected | 178 ++++++++++++++++++
 .../renamer/id-func-multi-postfix.expected    | 171 +++++++++++++++++
 8 files changed, 676 insertions(+), 15 deletions(-)
 create mode 100644 lib/haskell/natural4/test/testdata/golden/renamer/fail-id-func-multi-wrong-arity-1.expected
 create mode 100644 lib/haskell/natural4/test/testdata/golden/renamer/fail-id-func-multi-wrong-arity-2.expected
 create mode 100644 lib/haskell/natural4/test/testdata/golden/renamer/fail-id-func-multi-wrong-arity-3.expected
 create mode 100644 lib/haskell/natural4/test/testdata/golden/renamer/fail-id-func-multi-wrong-arity-4.expected
 create mode 100644 lib/haskell/natural4/test/testdata/golden/renamer/id-func-multi-postfix.expected

diff --git a/lib/haskell/natural4/src/LS/Renamer.hs b/lib/haskell/natural4/src/LS/Renamer.hs
index d39a7ad75..546883fd2 100644
--- a/lib/haskell/natural4/src/LS/Renamer.hs
+++ b/lib/haskell/natural4/src/LS/Renamer.hs
@@ -311,9 +311,12 @@ insertFunction rnFnName funcInfo =
     )
     (Just funcInfo)
 
-lookupFunction :: RnName -> Renamer (Maybe FuncInfo)
-lookupFunction rnFnName =
-  use (scScopeTable % stFunction % at rnFnName)
+lookupExistingFunction :: RnName -> Renamer FuncInfo
+lookupExistingFunction rnFnName = do
+  funcInfoM <- use (scScopeTable % stFunction % at rnFnName)
+  case funcInfoM of
+    Nothing -> throwError $ "lookupExistingFunction: Assumptions violated, function name wasn't found: " <> show rnFnName
+    Just funcInfo -> pure funcInfo
 
 -- | Execute a 'Renamer' action, but record which 'RnName's and 'FuncInfo'
 -- were introduced during this action.
@@ -343,7 +346,7 @@ data MultiTermContext = MultiTermContext
   -- we can infer that @"title"@ is a 'RnSelector'.
   , _multiTermContextFunctionCall :: Maybe RnName
   -- ^ During renaming a 'MultiTerm', did we encounter a function application?
-  -- If so, we need to fix the arity!
+  -- If so, we want to fix the call convention from infix/postfix to prefix!
   }
 
 makeFields 'MultiTermContext
@@ -572,7 +575,7 @@ scanTypeSignature sig = case sig of
 -- to be of the following form:
 --
 -- @
--- GIVEN x IS ONE OF foo, bar, foo baz
+-- GIVEN x IS ONE OF foo, bar, `foo baz`
 -- @
 --
 -- This means 'x' is one of three possible enum values 'foo', 'bar'
@@ -614,7 +617,6 @@ scanTypeDeclName mtexprs = do
 -- GIVETH's are global
 -- GIVEN's are local
 -- DECIDE head term in "IS" clauses is global
---
 renameRules :: (Traversable f) => f Rule -> Renamer (f RnRule)
 renameRules rules = do
   rulesWithLocalDefs <-
@@ -814,6 +816,26 @@ renameBoolStruct = \case
     pure $ AA.Any lbl rnBoolStruct
   AA.Not cs -> AA.Not <$> renameBoolStruct cs
 
+-- | Rename a 'LS.MultiTerm' and turn each 'LS.MTExpr' into a 'RnExpr'.
+--
+-- Renaming a list of 'LS.MTExpr' cannot be done without keeping intermediate
+-- state. Take for example this input:
+--
+-- @[MTT "x's", MTT "y's", MTT "z"]@
+--
+-- In this example, @x's@ and @y's@ can be relatively unambiguously renamed,
+-- but @z@ is tricky. Without context, @z@ could be a variable, a string
+-- constant... or perhaps even a function name! No real way to tell, as the
+-- syntax of the 'LS.MultiTerm' is ambiguous.
+--
+-- To resolve this ambiguity, we keep track of intermediate state in
+-- 'MultiTermContext'. Using this intermediate state, we can clearly
+-- disambiguate @z@ as being a 'RnSelector', as it is the last element
+-- of a "selector chain".
+--
+-- Further, we analyze whether we encounter a function application. If so,
+-- we prepare fixing all function applications to their prefix form.
+-- For example, @[MTT "x", MTT "f"]@ will be changed @[MTT "f", MTT "x"]@.
 renameMultiTerm :: LS.MultiTerm -> Renamer RnMultiTerm
 renameMultiTerm multiTerms = do
   (reversedRnMultiTerms, ctx) <-
@@ -826,17 +848,45 @@ renameMultiTerm multiTerms = do
       multiTerms
   let
     rnMultiTerms = reverse reversedRnMultiTerms
-  fixityFixedRnMultiTerms <- fixFixity ctx rnMultiTerms
-  pure fixityFixedRnMultiTerms
+  fixFixity ctx rnMultiTerms
  where
   fixFixity ctx rnMultiTerms = case ctx ^. functionCall of
     Nothing -> pure rnMultiTerms
     Just fnName -> do
+      funcInfo <- lookupExistingFunction fnName
       let
-        (preArgs, postArgsWithName) = List.break (== (RnExprName fnName)) rnMultiTerms
-      case postArgsWithName of
-        [] -> throwError ""
-        (fnExpr : postArgs) -> pure $ fnExpr : preArgs ++ postArgs
+        (preNum, postNum) = funcInfo ^. funcArity
+      (lhs, fnExpr, rhs) <- findFunctionApplication fnName rnMultiTerms
+      (leftNonArgs, leftArgs) <- processLhs preNum lhs
+      (rightNonArgs, rightArgs) <- processRhs postNum rhs
+      pure $ reverse leftNonArgs <> [fnExpr] <> leftArgs <> rightArgs <> rightNonArgs
+
+  findFunctionApplication fnName rnMultiTerms = do
+    let
+      (preArgs, postArgsWithName) = List.break (== (RnExprName fnName)) rnMultiTerms
+    case postArgsWithName of
+      [] -> throwError "fixFixity: Invariant violated, function name reported, but none found."
+      (fnExpr : postArgs) -> pure (preArgs, fnExpr, postArgs)
+
+  processLhs n lhs = do
+    case safeSplitAt n (reverse lhs) of
+      Nothing ->
+        throwError $
+          "Not enough elements in left hand side of function application. Required: "
+            <> show n
+            <> " but got: "
+            <> show (length lhs)
+      Just (args, nonArgs) -> pure (reverse nonArgs, reverse args)
+
+  processRhs n rhs = do
+    case safeSplitAt n rhs of
+      Nothing ->
+        throwError $
+          "Not enough elements in left hand side of function application. Required: "
+            <> show n
+            <> " but got: "
+            <> show (length rhs)
+      Just (nonArgs, args) -> pure (nonArgs, args)
 
   initialMultiTermContext =
     MultiTermContext
@@ -844,6 +894,7 @@ renameMultiTerm multiTerms = do
       , _multiTermContextFunctionCall = Nothing
       }
 
+-- | Rename a single 'LS.MTExpr' to a 'RnExpr'.
 renameMultiTermExpression :: MultiTermContext -> LS.MTExpr -> Renamer (RnExpr, MultiTermContext)
 renameMultiTermExpression ctx = \case
   -- TODO: this could be an expression such as "2+2" (for whatever reason), so perhaps
@@ -1001,3 +1052,17 @@ isGenitive = Text.stripSuffix genitiveSuffix
 
 genitiveSuffix :: Text
 genitiveSuffix = Text.pack "'s"
+
+-- | Like 'splitAt', but produces a 'Nothing' if there are not enough elements.
+safeSplitAt :: Int -> [a] -> Maybe ([a], [a])
+safeSplitAt i _as
+  | i < 0 = Nothing
+safeSplitAt i as =
+  case go i as [] of
+    Nothing -> Nothing
+    Just (lhs, rhs) -> Just (reverse lhs, rhs)
+ where
+  go 0 [] lhs = Just (lhs, [])
+  go _n [] _lhs = Nothing
+  go 0 xs lhs = Just (lhs, xs)
+  go n (x : xs) lhs = go (n - 1) xs (x : lhs)
diff --git a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
index 0868225a1..1ab3ad183 100644
--- a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
+++ b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
@@ -47,8 +47,10 @@ data SimalaTerm
   = -- | The head of a simala function.
     -- For example @f(x, y)@, where @f@ is a function and @x,y@ are its parameters.
     --
-    -- This is primarily used to translate a function head when we don't
-    -- know yet how to translate the body expression of the function.
+    -- This constructor is used to model function application of any supported
+    -- form, and declaration of function definitions, e.g. `f x IS ...`, then
+    -- 'TermApp' could be @'TermApp' "f" ["x"]@. Such a definition needs to be
+    -- translated to 'TermFunction' once the right hand side is translated.
     TermApp Simala.Name [Simala.Name]
   | -- | Assign the given name with some expression.
     -- May contain intermediate selectors.
@@ -202,7 +204,23 @@ groupClauses simalaTerms = do
   compareClauseHeads _ _ = False
 
 -- | Takes the translation of local variables in where clauses and turns
--- them into a Simala-let underneath potential lambdas.
+-- them into a Simala-let underneath potential lambdas or variable definitions.
+--
+-- Local definitions are, by definition, local to the encompassing 'SimalaTerm'
+-- and may depend on parameters of said encompassing 'SimalaTerm'.
+-- As such, the local definitions need to be added to the 'SimalaTerm', such
+-- that it has access to said local definitions.
+--
+-- We do this, by moving local definition inside of any lambdas or let-ins
+-- for variables.
+--
+-- For example
+--
+-- @GIVEN x DECIDE f x IS y WHERE y IS SUM(x,x)@
+--
+-- is supposed to be translated to:
+--
+-- @let f = fun(x) => let y = x + x in y@
 addLocalDefinitions :: SimalaTerm -> [SimalaTerm] -> Transpiler SimalaTerm
 addLocalDefinitions top [] = pure top
 addLocalDefinitions top (x : xs) = case top of
@@ -236,6 +254,7 @@ addLocalDefinitions top (x : xs) = case top of
         pure $ mkFunction t fnName fnParams fnExpr inExpr
 
 -- | Given a collection of groups, merge each group into a single expression.
+--
 mergeGroups :: (Traversable t) => t (NonEmpty (SimalaTerm, Maybe Simala.Expr)) -> Transpiler (t SimalaTerm)
 mergeGroups simalaTermGroups = do
   traverse mergeGroups' simalaTermGroups
diff --git a/lib/haskell/natural4/test/LS/RenamerSpec.hs b/lib/haskell/natural4/test/LS/RenamerSpec.hs
index 171ef43a0..80a8a948f 100644
--- a/lib/haskell/natural4/test/LS/RenamerSpec.hs
+++ b/lib/haskell/natural4/test/LS/RenamerSpec.hs
@@ -59,6 +59,54 @@ DECIDE f x IS x
 GIVEN x
 DECIDE g x IS x
         |]
+    test'
+      "id-func-multi-postfix"
+      [i|
+GIVEN x
+DECIDE f x IS x g
+§
+GIVEN x
+DECIDE x g IS x
+        |]
+    test'
+      "fail-id-func-multi-wrong-arity-1"
+      [i|
+GIVEN x
+DECIDE f x IS g x
+§
+GIVEN x
+DECIDE x g IS x
+        |]
+    test'
+      "fail-id-func-multi-wrong-arity-2"
+      [i|
+GIVEN x
+DECIDE f x IS g x x
+§
+GIVEN x
+DECIDE x g IS x
+        |]
+    test'
+      "fail-id-func-multi-wrong-arity-3"
+      -- This doesn't fail as it can be renamed to
+      -- `x g x`, which is strictly speaking legit. Perhaps,
+      -- if `x` is a function, this even makes sense?
+      [i|
+GIVEN x
+DECIDE f x IS x x g
+§
+GIVEN x
+DECIDE x g IS x
+        |]
+    test'
+      "fail-id-func-multi-wrong-arity-4"
+      [i|
+GIVEN x
+DECIDE f x IS x g x
+§
+GIVEN x
+DECIDE x g IS x
+        |]
  where
   test' :: String -> String -> SpecWith (Arg (Golden TL.Text))
   test' fname ruleSource = do
diff --git a/lib/haskell/natural4/test/testdata/golden/renamer/fail-id-func-multi-wrong-arity-1.expected b/lib/haskell/natural4/test/testdata/golden/renamer/fail-id-func-multi-wrong-arity-1.expected
new file mode 100644
index 000000000..c6d594003
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/renamer/fail-id-func-multi-wrong-arity-1.expected
@@ -0,0 +1 @@
+Left "Failed to rename program: Not enough elements in left hand side of function application. Required: 1 but got: 0"
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/renamer/fail-id-func-multi-wrong-arity-2.expected b/lib/haskell/natural4/test/testdata/golden/renamer/fail-id-func-multi-wrong-arity-2.expected
new file mode 100644
index 000000000..c6d594003
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/renamer/fail-id-func-multi-wrong-arity-2.expected
@@ -0,0 +1 @@
+Left "Failed to rename program: Not enough elements in left hand side of function application. Required: 1 but got: 0"
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/renamer/fail-id-func-multi-wrong-arity-3.expected b/lib/haskell/natural4/test/testdata/golden/renamer/fail-id-func-multi-wrong-arity-3.expected
new file mode 100644
index 000000000..307c3986e
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/renamer/fail-id-func-multi-wrong-arity-3.expected
@@ -0,0 +1,178 @@
+Right
+    [ Hornlike
+        ( RnHornlike
+            { name =
+                [ RnExprName
+                    ( RnName
+                        { rnOccName = MTT "f" :| []
+                        , rnUniqueId = 1
+                        , rnNameType = RnFunction
+                        }
+                    )
+                , RnExprName
+                    ( RnName
+                        { rnOccName = MTT "x" :| []
+                        , rnUniqueId = 0
+                        , rnNameType = RnVariable
+                        }
+                    )
+                ]
+            , super = Nothing
+            , keyword = Decide
+            , given = Just
+                ( RnParamText
+                    { mkParamText = RnTypedMulti
+                        { rnTypedMultiExpr = RnExprName
+                            ( RnName
+                                { rnOccName = MTT "x" :| []
+                                , rnUniqueId = 0
+                                , rnNameType = RnVariable
+                                }
+                            ) :| []
+                        , rnTypedMultiTypeSig = Nothing
+                        } :| []
+                    }
+                )
+            , giveth = Nothing
+            , upon = Nothing
+            , clauses =
+                [ RnHornClause
+                    { rnHcHead = RnConstraint
+                        [ RnExprName
+                            ( RnName
+                                { rnOccName = MTT "f" :| []
+                                , rnUniqueId = 1
+                                , rnNameType = RnFunction
+                                }
+                            )
+                        , RnExprName
+                            ( RnName
+                                { rnOccName = MTT "x" :| []
+                                , rnUniqueId = 0
+                                , rnNameType = RnVariable
+                                }
+                            )
+                        ] RPis
+                        [ RnExprName
+                            ( RnName
+                                { rnOccName = MTT "x" :| []
+                                , rnUniqueId = 0
+                                , rnNameType = RnVariable
+                                }
+                            )
+                        , RnExprName
+                            ( RnName
+                                { rnOccName = MTT "g" :| []
+                                , rnUniqueId = 3
+                                , rnNameType = RnFunction
+                                }
+                            )
+                        , RnExprName
+                            ( RnName
+                                { rnOccName = MTT "x" :| []
+                                , rnUniqueId = 0
+                                , rnNameType = RnVariable
+                                }
+                            )
+                        ]
+                    , rnHcBody = Nothing
+                    }
+                ]
+            , rlabel = Nothing
+            , lsource = Nothing
+            , wwhere = []
+            , srcref = Just
+                ( SrcRef
+                    { url = "test/Spec"
+                    , short = "test/Spec"
+                    , srcrow = 1
+                    , srccol = 1
+                    , version = Nothing
+                    }
+                )
+            , defaults = []
+            , symtab = []
+            }
+        )
+    , Hornlike
+        ( RnHornlike
+            { name =
+                [ RnExprName
+                    ( RnName
+                        { rnOccName = MTT "g" :| []
+                        , rnUniqueId = 3
+                        , rnNameType = RnFunction
+                        }
+                    )
+                , RnExprName
+                    ( RnName
+                        { rnOccName = MTT "x" :| []
+                        , rnUniqueId = 2
+                        , rnNameType = RnVariable
+                        }
+                    )
+                ]
+            , super = Nothing
+            , keyword = Decide
+            , given = Just
+                ( RnParamText
+                    { mkParamText = RnTypedMulti
+                        { rnTypedMultiExpr = RnExprName
+                            ( RnName
+                                { rnOccName = MTT "x" :| []
+                                , rnUniqueId = 2
+                                , rnNameType = RnVariable
+                                }
+                            ) :| []
+                        , rnTypedMultiTypeSig = Nothing
+                        } :| []
+                    }
+                )
+            , giveth = Nothing
+            , upon = Nothing
+            , clauses =
+                [ RnHornClause
+                    { rnHcHead = RnConstraint
+                        [ RnExprName
+                            ( RnName
+                                { rnOccName = MTT "g" :| []
+                                , rnUniqueId = 3
+                                , rnNameType = RnFunction
+                                }
+                            )
+                        , RnExprName
+                            ( RnName
+                                { rnOccName = MTT "x" :| []
+                                , rnUniqueId = 2
+                                , rnNameType = RnVariable
+                                }
+                            )
+                        ] RPis
+                        [ RnExprName
+                            ( RnName
+                                { rnOccName = MTT "x" :| []
+                                , rnUniqueId = 2
+                                , rnNameType = RnVariable
+                                }
+                            )
+                        ]
+                    , rnHcBody = Nothing
+                    }
+                ]
+            , rlabel = Nothing
+            , lsource = Nothing
+            , wwhere = []
+            , srcref = Just
+                ( SrcRef
+                    { url = "test/Spec"
+                    , short = "test/Spec"
+                    , srcrow = 1
+                    , srccol = 1
+                    , version = Nothing
+                    }
+                )
+            , defaults = []
+            , symtab = []
+            }
+        )
+    ]
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/renamer/fail-id-func-multi-wrong-arity-4.expected b/lib/haskell/natural4/test/testdata/golden/renamer/fail-id-func-multi-wrong-arity-4.expected
new file mode 100644
index 000000000..c59d0f139
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/renamer/fail-id-func-multi-wrong-arity-4.expected
@@ -0,0 +1,178 @@
+Right
+    [ Hornlike
+        ( RnHornlike
+            { name =
+                [ RnExprName
+                    ( RnName
+                        { rnOccName = MTT "f" :| []
+                        , rnUniqueId = 1
+                        , rnNameType = RnFunction
+                        }
+                    )
+                , RnExprName
+                    ( RnName
+                        { rnOccName = MTT "x" :| []
+                        , rnUniqueId = 0
+                        , rnNameType = RnVariable
+                        }
+                    )
+                ]
+            , super = Nothing
+            , keyword = Decide
+            , given = Just
+                ( RnParamText
+                    { mkParamText = RnTypedMulti
+                        { rnTypedMultiExpr = RnExprName
+                            ( RnName
+                                { rnOccName = MTT "x" :| []
+                                , rnUniqueId = 0
+                                , rnNameType = RnVariable
+                                }
+                            ) :| []
+                        , rnTypedMultiTypeSig = Nothing
+                        } :| []
+                    }
+                )
+            , giveth = Nothing
+            , upon = Nothing
+            , clauses =
+                [ RnHornClause
+                    { rnHcHead = RnConstraint
+                        [ RnExprName
+                            ( RnName
+                                { rnOccName = MTT "f" :| []
+                                , rnUniqueId = 1
+                                , rnNameType = RnFunction
+                                }
+                            )
+                        , RnExprName
+                            ( RnName
+                                { rnOccName = MTT "x" :| []
+                                , rnUniqueId = 0
+                                , rnNameType = RnVariable
+                                }
+                            )
+                        ] RPis
+                        [ RnExprName
+                            ( RnName
+                                { rnOccName = MTT "g" :| []
+                                , rnUniqueId = 3
+                                , rnNameType = RnFunction
+                                }
+                            )
+                        , RnExprName
+                            ( RnName
+                                { rnOccName = MTT "x" :| []
+                                , rnUniqueId = 0
+                                , rnNameType = RnVariable
+                                }
+                            )
+                        , RnExprName
+                            ( RnName
+                                { rnOccName = MTT "x" :| []
+                                , rnUniqueId = 0
+                                , rnNameType = RnVariable
+                                }
+                            )
+                        ]
+                    , rnHcBody = Nothing
+                    }
+                ]
+            , rlabel = Nothing
+            , lsource = Nothing
+            , wwhere = []
+            , srcref = Just
+                ( SrcRef
+                    { url = "test/Spec"
+                    , short = "test/Spec"
+                    , srcrow = 1
+                    , srccol = 1
+                    , version = Nothing
+                    }
+                )
+            , defaults = []
+            , symtab = []
+            }
+        )
+    , Hornlike
+        ( RnHornlike
+            { name =
+                [ RnExprName
+                    ( RnName
+                        { rnOccName = MTT "g" :| []
+                        , rnUniqueId = 3
+                        , rnNameType = RnFunction
+                        }
+                    )
+                , RnExprName
+                    ( RnName
+                        { rnOccName = MTT "x" :| []
+                        , rnUniqueId = 2
+                        , rnNameType = RnVariable
+                        }
+                    )
+                ]
+            , super = Nothing
+            , keyword = Decide
+            , given = Just
+                ( RnParamText
+                    { mkParamText = RnTypedMulti
+                        { rnTypedMultiExpr = RnExprName
+                            ( RnName
+                                { rnOccName = MTT "x" :| []
+                                , rnUniqueId = 2
+                                , rnNameType = RnVariable
+                                }
+                            ) :| []
+                        , rnTypedMultiTypeSig = Nothing
+                        } :| []
+                    }
+                )
+            , giveth = Nothing
+            , upon = Nothing
+            , clauses =
+                [ RnHornClause
+                    { rnHcHead = RnConstraint
+                        [ RnExprName
+                            ( RnName
+                                { rnOccName = MTT "g" :| []
+                                , rnUniqueId = 3
+                                , rnNameType = RnFunction
+                                }
+                            )
+                        , RnExprName
+                            ( RnName
+                                { rnOccName = MTT "x" :| []
+                                , rnUniqueId = 2
+                                , rnNameType = RnVariable
+                                }
+                            )
+                        ] RPis
+                        [ RnExprName
+                            ( RnName
+                                { rnOccName = MTT "x" :| []
+                                , rnUniqueId = 2
+                                , rnNameType = RnVariable
+                                }
+                            )
+                        ]
+                    , rnHcBody = Nothing
+                    }
+                ]
+            , rlabel = Nothing
+            , lsource = Nothing
+            , wwhere = []
+            , srcref = Just
+                ( SrcRef
+                    { url = "test/Spec"
+                    , short = "test/Spec"
+                    , srcrow = 1
+                    , srccol = 1
+                    , version = Nothing
+                    }
+                )
+            , defaults = []
+            , symtab = []
+            }
+        )
+    ]
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/renamer/id-func-multi-postfix.expected b/lib/haskell/natural4/test/testdata/golden/renamer/id-func-multi-postfix.expected
new file mode 100644
index 000000000..9efdff0f2
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/renamer/id-func-multi-postfix.expected
@@ -0,0 +1,171 @@
+Right
+    [ Hornlike
+        ( RnHornlike
+            { name =
+                [ RnExprName
+                    ( RnName
+                        { rnOccName = MTT "f" :| []
+                        , rnUniqueId = 1
+                        , rnNameType = RnFunction
+                        }
+                    )
+                , RnExprName
+                    ( RnName
+                        { rnOccName = MTT "x" :| []
+                        , rnUniqueId = 0
+                        , rnNameType = RnVariable
+                        }
+                    )
+                ]
+            , super = Nothing
+            , keyword = Decide
+            , given = Just
+                ( RnParamText
+                    { mkParamText = RnTypedMulti
+                        { rnTypedMultiExpr = RnExprName
+                            ( RnName
+                                { rnOccName = MTT "x" :| []
+                                , rnUniqueId = 0
+                                , rnNameType = RnVariable
+                                }
+                            ) :| []
+                        , rnTypedMultiTypeSig = Nothing
+                        } :| []
+                    }
+                )
+            , giveth = Nothing
+            , upon = Nothing
+            , clauses =
+                [ RnHornClause
+                    { rnHcHead = RnConstraint
+                        [ RnExprName
+                            ( RnName
+                                { rnOccName = MTT "f" :| []
+                                , rnUniqueId = 1
+                                , rnNameType = RnFunction
+                                }
+                            )
+                        , RnExprName
+                            ( RnName
+                                { rnOccName = MTT "x" :| []
+                                , rnUniqueId = 0
+                                , rnNameType = RnVariable
+                                }
+                            )
+                        ] RPis
+                        [ RnExprName
+                            ( RnName
+                                { rnOccName = MTT "g" :| []
+                                , rnUniqueId = 3
+                                , rnNameType = RnFunction
+                                }
+                            )
+                        , RnExprName
+                            ( RnName
+                                { rnOccName = MTT "x" :| []
+                                , rnUniqueId = 0
+                                , rnNameType = RnVariable
+                                }
+                            )
+                        ]
+                    , rnHcBody = Nothing
+                    }
+                ]
+            , rlabel = Nothing
+            , lsource = Nothing
+            , wwhere = []
+            , srcref = Just
+                ( SrcRef
+                    { url = "test/Spec"
+                    , short = "test/Spec"
+                    , srcrow = 1
+                    , srccol = 1
+                    , version = Nothing
+                    }
+                )
+            , defaults = []
+            , symtab = []
+            }
+        )
+    , Hornlike
+        ( RnHornlike
+            { name =
+                [ RnExprName
+                    ( RnName
+                        { rnOccName = MTT "g" :| []
+                        , rnUniqueId = 3
+                        , rnNameType = RnFunction
+                        }
+                    )
+                , RnExprName
+                    ( RnName
+                        { rnOccName = MTT "x" :| []
+                        , rnUniqueId = 2
+                        , rnNameType = RnVariable
+                        }
+                    )
+                ]
+            , super = Nothing
+            , keyword = Decide
+            , given = Just
+                ( RnParamText
+                    { mkParamText = RnTypedMulti
+                        { rnTypedMultiExpr = RnExprName
+                            ( RnName
+                                { rnOccName = MTT "x" :| []
+                                , rnUniqueId = 2
+                                , rnNameType = RnVariable
+                                }
+                            ) :| []
+                        , rnTypedMultiTypeSig = Nothing
+                        } :| []
+                    }
+                )
+            , giveth = Nothing
+            , upon = Nothing
+            , clauses =
+                [ RnHornClause
+                    { rnHcHead = RnConstraint
+                        [ RnExprName
+                            ( RnName
+                                { rnOccName = MTT "g" :| []
+                                , rnUniqueId = 3
+                                , rnNameType = RnFunction
+                                }
+                            )
+                        , RnExprName
+                            ( RnName
+                                { rnOccName = MTT "x" :| []
+                                , rnUniqueId = 2
+                                , rnNameType = RnVariable
+                                }
+                            )
+                        ] RPis
+                        [ RnExprName
+                            ( RnName
+                                { rnOccName = MTT "x" :| []
+                                , rnUniqueId = 2
+                                , rnNameType = RnVariable
+                                }
+                            )
+                        ]
+                    , rnHcBody = Nothing
+                    }
+                ]
+            , rlabel = Nothing
+            , lsource = Nothing
+            , wwhere = []
+            , srcref = Just
+                ( SrcRef
+                    { url = "test/Spec"
+                    , short = "test/Spec"
+                    , srcrow = 1
+                    , srccol = 1
+                    , version = Nothing
+                    }
+                )
+            , defaults = []
+            , symtab = []
+            }
+        )
+    ]
\ No newline at end of file

From 6c2dc397a109fe0d3086550e5954eb25bd8a2e14 Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Tue, 13 Aug 2024 09:11:50 +0200
Subject: [PATCH 24/44] Fix test indentation

---
 lib/haskell/natural4/test/LS/RenamerSpec.hs | 60 ++++++++++-----------
 1 file changed, 30 insertions(+), 30 deletions(-)

diff --git a/lib/haskell/natural4/test/LS/RenamerSpec.hs b/lib/haskell/natural4/test/LS/RenamerSpec.hs
index 80a8a948f..fd7da5794 100644
--- a/lib/haskell/natural4/test/LS/RenamerSpec.hs
+++ b/lib/haskell/natural4/test/LS/RenamerSpec.hs
@@ -53,38 +53,38 @@ spec = do
     test'
       "id-func-multi"
       [i|
-GIVEN x
-DECIDE f x IS x
-§
-GIVEN x
-DECIDE g x IS x
+        GIVEN x
+        DECIDE f x IS x
+        §
+        GIVEN x
+        DECIDE g x IS x
         |]
     test'
       "id-func-multi-postfix"
       [i|
-GIVEN x
-DECIDE f x IS x g
-§
-GIVEN x
-DECIDE x g IS x
+        GIVEN x
+        DECIDE f x IS x g
+        §
+        GIVEN x
+        DECIDE x g IS x
         |]
     test'
       "fail-id-func-multi-wrong-arity-1"
       [i|
-GIVEN x
-DECIDE f x IS g x
-§
-GIVEN x
-DECIDE x g IS x
+        GIVEN x
+        DECIDE f x IS g x
+        §
+        GIVEN x
+        DECIDE x g IS x
         |]
     test'
       "fail-id-func-multi-wrong-arity-2"
       [i|
-GIVEN x
-DECIDE f x IS g x x
-§
-GIVEN x
-DECIDE x g IS x
+        GIVEN x
+        DECIDE f x IS g x x
+        §
+        GIVEN x
+        DECIDE x g IS x
         |]
     test'
       "fail-id-func-multi-wrong-arity-3"
@@ -92,20 +92,20 @@ DECIDE x g IS x
       -- `x g x`, which is strictly speaking legit. Perhaps,
       -- if `x` is a function, this even makes sense?
       [i|
-GIVEN x
-DECIDE f x IS x x g
-§
-GIVEN x
-DECIDE x g IS x
+        GIVEN x
+        DECIDE f x IS x x g
+        §
+        GIVEN x
+        DECIDE x g IS x
         |]
     test'
       "fail-id-func-multi-wrong-arity-4"
       [i|
-GIVEN x
-DECIDE f x IS x g x
-§
-GIVEN x
-DECIDE x g IS x
+        GIVEN x
+        DECIDE f x IS x g x
+        §
+        GIVEN x
+        DECIDE x g IS x
         |]
  where
   test' :: String -> String -> SpecWith (Arg (Golden TL.Text))

From 49226779858e84f7deade8b5f10740f115ae0b68 Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Tue, 13 Aug 2024 09:42:35 +0200
Subject: [PATCH 25/44] Add Simala transpiler backend

---
 lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs           | 7 +++++++
 .../golden/xpile/simala/function-nested-builtins.expected  | 1 +
 2 files changed, 8 insertions(+)
 create mode 100644 lib/haskell/natural4/test/testdata/golden/xpile/simala/function-nested-builtins.expected

diff --git a/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs b/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
index 9bf7c0313..da587b673 100644
--- a/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
+++ b/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
@@ -170,6 +170,13 @@ basicTests = do
     [i|
       DECIDE y's z IS 5
       |]
+  transpilerTest
+    "function-nested-builtins"
+    [i|
+      GIVEN x IS A Number ;
+            y IS A Number
+      DECIDE x `discounted by` y IS SUM(x, MINUS(1, y))
+    |]
 
 multiRuleTests :: Spec
 multiRuleTests = describe "multi-rules" do
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-nested-builtins.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-nested-builtins.expected
new file mode 100644
index 000000000..51ce3a355
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-nested-builtins.expected
@@ -0,0 +1 @@
+let f_discounted_by_3 = fun (v_x_0,v_y_2) => v_x_0 + (1 - v_y_2) in undefined
\ No newline at end of file

From b7dd0bb41e45dd73e2157e9e4bee0cefef30d839 Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Tue, 13 Aug 2024 13:22:18 +0200
Subject: [PATCH 26/44] Add more documentation to simala

---
 lib/haskell/natural4/src/LS/Renamer.hs        |  80 +++-
 .../natural4/src/LS/XPile/Simala/Transpile.hs | 344 +++---------------
 2 files changed, 110 insertions(+), 314 deletions(-)

diff --git a/lib/haskell/natural4/src/LS/Renamer.hs b/lib/haskell/natural4/src/LS/Renamer.hs
index 546883fd2..c40b0a0bb 100644
--- a/lib/haskell/natural4/src/LS/Renamer.hs
+++ b/lib/haskell/natural4/src/LS/Renamer.hs
@@ -10,7 +10,52 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# OPTIONS_GHC -Wall #-}
 
-module LS.Renamer where
+module LS.Renamer (
+  -- * Renamed Rule types
+  RnRule (..),
+  RnHornlike (..),
+  RnTypeDecl (..),
+  RnHornClause(..),
+  RnTypedMulti(..),
+  RnMultiTerm,
+  RnExpr(..),
+  RnName(..),
+  RnNameType(..),
+  RnLit(..),
+  RnRelationalPredicate(..),
+  RnBoolStructR,
+  OccName,
+  Unique,
+  mkSimpleOccName,
+  -- * Renamer Monad and runners
+  Renamer(..),
+  runRenamerFor,
+
+  -- * Scope checking types
+  Scope (..),
+  scScopeTable,
+  scUniqueSupply,
+  newUnique,
+  lookupName,
+  lookupExistingName,
+  lookupOrInsertName,
+  insertName,
+  insertFunction,
+  lookupExistingFunction,
+  ScopeTable (..),
+  stVariables,
+  stFunction,
+  unionScopeTable,
+  differenceScopeTable,
+  emptyScopeTable,
+  FuncInfo (..),
+  -- * Assertion helpers
+  assertEmptyList,
+  assertSingletonMultiTerm,
+  assertNoTypeSignature,
+  -- * Debugging helpers
+  renameRuleTopLevel,
+) where
 
 import AnyAll.BoolStruct qualified as AA
 import LS.Rule (Rule, RuleLabel)
@@ -45,7 +90,11 @@ import Text.Pretty.Simple qualified as Pretty
 -- Types specific to the renamer phase
 -- ----------------------------------------------------------------------------
 
--- | A rename rule is the same as a 'Rule' but
+-- | A rename rule is the same as a 'Rule' but names that occur in the rule
+-- are resolved and renamed.
+-- This aims to provide common ground for transpilers, s.t. a transpiler can
+-- assume a name is already defined, and language ambiguities are resolved.
+-- Further, this representation aims to be usable for typechecking.
 data RnRule
   = Hornlike RnHornlike
   | TypeDecl RnTypeDecl
@@ -54,6 +103,8 @@ data RnRule
 type RnBoolStructR = AA.OptionallyLabeledBoolStruct RnRelationalPredicate
 
 -- | Corresponds to 'HornClause2', which is equivalent to @HornClause BoolStructR@.
+--
+-- We don't seem to require any parameterization.
 data RnHornClause = RnHornClause
   { rnHcHead :: RnRelationalPredicate
   , rnHcBody :: Maybe RnBoolStructR
@@ -177,7 +228,6 @@ data FuncInfo = FuncInfo
 
 mkSimpleOccName :: Text -> OccName
 mkSimpleOccName = NE.singleton . LS.MTT
-
 data Scope = Scope
   { _scScopeTable :: ScopeTable
   , _scUniqueSupply :: Unique
@@ -214,10 +264,6 @@ differenceScopeTable tbl1 tbl2 =
     , _stFunction = Map.difference tbl1._stFunction tbl2._stFunction
     }
 
-makeFieldsNoPrefix 'Scope
-makeFieldsNoPrefix 'ScopeTable
-makeFieldsNoPrefix 'FuncInfo
-
 emptyScopeTable :: ScopeTable
 emptyScopeTable =
   ScopeTable
@@ -225,6 +271,11 @@ emptyScopeTable =
     , _stFunction = Map.empty
     }
 
+makeFieldsNoPrefix 'Scope
+makeFieldsNoPrefix 'ScopeTable
+makeFieldsNoPrefix 'FuncInfo
+
+
 emptyScope :: Scope
 emptyScope =
   Scope
@@ -318,7 +369,7 @@ lookupExistingFunction rnFnName = do
     Nothing -> throwError $ "lookupExistingFunction: Assumptions violated, function name wasn't found: " <> show rnFnName
     Just funcInfo -> pure funcInfo
 
--- | Execute a 'Renamer' action, but record which 'RnName's and 'FuncInfo'
+-- | Execute a 'Renamer' action, but record which 'RnName's and 'FuncInfo's
 -- were introduced during this action.
 --
 -- Note, this operation is rather expensive, so use it with caution!
@@ -825,8 +876,8 @@ renameBoolStruct = \case
 --
 -- In this example, @x's@ and @y's@ can be relatively unambiguously renamed,
 -- but @z@ is tricky. Without context, @z@ could be a variable, a string
--- constant... or perhaps even a function name! No real way to tell, as the
--- syntax of the 'LS.MultiTerm' is ambiguous.
+-- constant... or perhaps even a function name! No way to tell, as the
+-- text fragment of the 'LS.MultiTerm' is ambiguous.
 --
 -- To resolve this ambiguity, we keep track of intermediate state in
 -- 'MultiTermContext'. Using this intermediate state, we can clearly
@@ -834,8 +885,10 @@ renameBoolStruct = \case
 -- of a "selector chain".
 --
 -- Further, we analyze whether we encounter a function application. If so,
--- we prepare fixing all function applications to their prefix form.
--- For example, @[MTT "x", MTT "f"]@ will be changed @[MTT "f", MTT "x"]@.
+-- we fix the function application to its prefix form.
+-- For example, @[MTT "x", MTT "f"]@ will be changed @[MTT "f", MTT "x"]@,
+-- if and only if @"f"@ is a known function variable in scope with associated
+-- arity information.
 renameMultiTerm :: LS.MultiTerm -> Renamer RnMultiTerm
 renameMultiTerm multiTerms = do
   (reversedRnMultiTerms, ctx) <-
@@ -1062,7 +1115,6 @@ safeSplitAt i as =
     Nothing -> Nothing
     Just (lhs, rhs) -> Just (reverse lhs, rhs)
  where
-  go 0 [] lhs = Just (lhs, [])
-  go _n [] _lhs = Nothing
   go 0 xs lhs = Just (lhs, xs)
+  go _n [] _lhs = Nothing
   go n (x : xs) lhs = go (n - 1) xs (x : lhs)
diff --git a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
index 1ab3ad183..9b02c5473 100644
--- a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
+++ b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
@@ -15,7 +15,6 @@ import Data.Function (on)
 import Data.List.NonEmpty (NonEmpty ((:|)))
 import Data.List.NonEmpty qualified as NE
 import Data.Maybe qualified as Maybe
-import Data.String.Interpolate
 import Data.Text (Text)
 import Data.Text qualified as Text
 import Data.Text.IO qualified as Text
@@ -32,7 +31,7 @@ import TextuaL4.Transform qualified as Parser
 
 import AnyAll.BoolStruct qualified as AA
 
-import Simala.Expr.Parser (mkIfThenElse)
+import Simala.Expr.Parser qualified as Simala
 import Simala.Expr.Render qualified as Simala
 import Simala.Expr.Type qualified as Simala
 
@@ -254,7 +253,6 @@ addLocalDefinitions top (x : xs) = case top of
         pure $ mkFunction t fnName fnParams fnExpr inExpr
 
 -- | Given a collection of groups, merge each group into a single expression.
---
 mergeGroups :: (Traversable t) => t (NonEmpty (SimalaTerm, Maybe Simala.Expr)) -> Transpiler (t SimalaTerm)
 mergeGroups simalaTermGroups = do
   traverse mergeGroups' simalaTermGroups
@@ -644,42 +642,50 @@ mkFunctionTerm fnName fnParams term = do
   body <- assertTermExpr term
   pure $ TermFunction Simala.Transparent fnName fnParams body
 
--- Andres: needs documentation
+-- | Combine two 'SimalaTerm's via a Simala 'if-then-else' expression.
+-- 'SimalaTerm's can not be generally combined. For example, combining
+-- a function term and a let-in term cannot be done meaningfully, since the
+-- result needs to be a single 'SimalaTerm' itself.
+-- However, 'SimalaTerm's of the same constructor can sometimes be meaningfully combined!
+-- For example, for two function terms with the same head (e.g., same name and same parameters),
+-- we may weave the 'if-then-else' into the function body.
+-- The same holds for 'TermLetIn' and 'TermAttribute' terms. Further, most terms can be combined
+-- with arbitrary 'TermExpr's.
 mkIfThenElseTerm :: Simala.Expr -> SimalaTerm -> SimalaTerm -> Transpiler SimalaTerm
 mkIfThenElseTerm b (TermLetIn t1 name1 expr1) (TermLetIn t2 name2 expr2) = do
   assertEquals t1 t2
   assertEquals name1 name2
   let
-    ifThenElse = mkIfThenElse b expr1 expr2
+    ifThenElse = Simala.mkIfThenElse b expr1 expr2
   pure $ TermLetIn t1 name1 ifThenElse
 mkIfThenElseTerm b (TermLetIn t1 name1 body1) (TermExpr expr) = do
   let
-    ifThenElse = mkIfThenElse b body1 expr
+    ifThenElse = Simala.mkIfThenElse b body1 expr
   pure $ TermLetIn t1 name1 ifThenElse
 mkIfThenElseTerm b (TermAttribute name1 selectors1 expr1) (TermAttribute name2 selectors2 expr2) = do
   assertEquals name1 name2
   assertEquals selectors1 selectors2
   let
-    ifThenElse = mkIfThenElse b expr1 expr2
+    ifThenElse = Simala.mkIfThenElse b expr1 expr2
   pure $ TermAttribute name1 selectors1 ifThenElse
 mkIfThenElseTerm b (TermAttribute name1 selectors1 expr1) (TermExpr expr2) = do
   let
-    ifThenElse = mkIfThenElse b expr1 expr2
+    ifThenElse = Simala.mkIfThenElse b expr1 expr2
   pure $ TermAttribute name1 selectors1 ifThenElse
 mkIfThenElseTerm b (TermFunction t1 fnName1 fnParams1 expr1) (TermFunction t2 fnName2 fnParams2 expr2) = do
   assertEquals t1 t2
   assertEquals fnName1 fnName2
   assertEquals fnParams1 fnParams2
   let
-    ifThenElse = mkIfThenElse b expr1 expr2
+    ifThenElse = Simala.mkIfThenElse b expr1 expr2
   pure $ TermFunction t1 fnName1 fnParams1 ifThenElse
 mkIfThenElseTerm b (TermFunction t fnName1 fnParams1 expr1) (TermExpr expr) = do
   let
-    ifThenElse = mkIfThenElse b expr1 expr
+    ifThenElse = Simala.mkIfThenElse b expr1 expr
   pure $ TermFunction t fnName1 fnParams1 ifThenElse
 mkIfThenElseTerm b (TermExpr expr1) (TermExpr expr2) = do
   let
-    ifThenElse = mkIfThenElse b expr1 expr2
+    ifThenElse = Simala.mkIfThenElse b expr1 expr2
   pure $ TermExpr ifThenElse
 mkIfThenElseTerm _b term1 term2 =
   throwError $
@@ -718,302 +724,40 @@ buildRecordUpdate names expr = go $ NE.toList names
   go [] = expr
   go (x : xs) = Simala.Record [(x, go xs)]
 
--- TODO: what was I thinking?
+-- | Given a list of record updates, merge them into a singular record update.
+-- Assumption: All record updates are unique, for example (in pseudo code):
+--
+-- @
+--  { x = { y = 5 } }
+--  { x = { z = { a = 0 } } }
+--  { x = { z = { b = 1 } } }
+--  { f = 2 }
+-- @
+--
+-- is merged into:
+--
+-- @
+--   { x = { y = 5, z = { a = 0, b = 1 } }, f = 2 }
+-- @
+--
 mergeRecordUpdates :: [Simala.Row Simala.Expr] -> Transpiler Simala.Expr
-mergeRecordUpdates xs = worker xs
+mergeRecordUpdates rows = do
+  let
+    vars = NE.groupAllWith fst $ concat rows
+  simpleRows <- traverse simplifyRow vars
+  pure $ Simala.Record simpleRows
  where
-  worker rows = do
-    let
-      vars = NE.groupAllWith fst $ concat rows
-    simpleRows <-
-      traverse
-        simplifyRow
-        vars
-    pure $ Simala.Record simpleRows
-
   simplifyRow ::
     NonEmpty (Simala.Name, Simala.Expr) ->
     Transpiler (Simala.Name, Simala.Expr)
   simplifyRow ((n, expr) :| []) = pure (n, expr)
-  simplifyRow rows@((n, _) :| _) = do
+  simplifyRow assignment = do
     let
-      rowExprs = fmap snd $ NE.toList rows
-    recordRows <- traverse assertIsRecord rowExprs
-    mergedRows <- worker recordRows
-    pure $ (n, mergedRows)
-
--- ----------------------------------------------------------------------------
--- Test cases
--- ----------------------------------------------------------------------------
-
--- >>> transpileRulePure outputWithIndirection
--- "let v_x_0 = let v_y_1 = 5 in v_y_1"
-
-outputWithIndirection :: String
-outputWithIndirection =
-  [i|
-GIVETH x
-DECIDE x IS y
-WHERE
-    y IS 5
-|]
-
--- >>> transpileRulePure exampleWithOneOf
--- "let f_g_4 = fun (v_d_0) => let v_y_1 = if v_d_0 > 0 then e_green_2 else if b_OTHERWISE_5 then e_red_3 else undefined in v_y_1 in undefined"
-
-exampleWithOneOf :: String
-exampleWithOneOf =
-  [i|
-GIVEN d
-GIVETH y IS ONE OF green, red
-DECIDE g d IS y
-WHERE
-    y IS green IF d > 0;
-    y IS red OTHERWISE
-|]
-
--- >>> transpileRulePure bookWithAttributes
--- "let f_g_1 = fun(v_d_0) => let v_y_2 = {s_book_3 = if v_d_0 > 0 then 'green else if b_OTHERWISE_4 then 'red else undefined} in v_y_2"
-
-bookWithAttributes :: String
-bookWithAttributes =
-  [i|
-GIVEN d
-DECIDE g d IS y
-WHERE
-    y's book IS green IF d > 0;
-    y's book IS red OTHERWISE
-|]
-
--- >>> transpileRulePure idFunction
--- "let f_id_1 = fun(v_x_0) => v_x_0"
-
-idFunction :: String
-idFunction =
-  [i|
-GIVEN x
-DECIDE id x IS x
-|]
-
--- >>> transpileRulePure sumFunction
--- "let f_sum3_1 = fun(v_x_0) => sum(v_x_0,v_x_0,v_x_0)"
-
-sumFunction :: String
-sumFunction =
-  [i|
-GIVEN x
-DECIDE sum3 x IS SUM(x, x, x)
-|]
-
--- >>> transpileRulePure simpleSelector
--- "let f_f_1 = fun(v_x_0) => v_x_0.s_z_2"
-
-simpleSelector :: String
-simpleSelector =
-  [i|
-GIVEN x
-DECIDE f x IS x's z
-|]
-
--- >>> transpileRulePure nestedSelector
--- "let f_f_1 = fun(v_x_0) => v_x_0.s_y_2.s_z_3"
-
-nestedSelector :: String
-nestedSelector =
-  [i|
-GIVEN x
-DECIDE f x IS x's y's z
-|]
-
--- >>> transpileRulePure decideWithIfs
--- "let f_f_1 = fun(v_x_0) => if v_x_0 > 0 then 1 else if b_OTHERWISE_2 then 0 else undefined"
-
-decideWithIfs :: String
-decideWithIfs =
-  [i|
-GIVEN x
-DECIDE f x IS 1 IF x > 0;
-       f x IS 0 OTHERWISE
-|]
-
--- >>> transpileRulePure decideWithIfsNoOtherwise
--- "let f_f_1 = fun(v_x_0) => if v_x_0 > 0 then 1 else 0"
-
-decideWithIfsNoOtherwise :: String
-decideWithIfsNoOtherwise =
-  [i|
-GIVEN x
-DECIDE f x IS 1 IF x > 0;
-       f x IS 0
-|]
-
--- f = fun(x) => if y > 0 then 1 else 0
--- let otherwise = true
--- in
---  let f = fun(x) => if y > 0 then 1 else 0
-
--- >>> transpileRulePure decideWithIfs2
--- "let f_f_1 = fun(v_x_0) => if v_x_0 > 0 then 1 else if b_OTHERWISE_2 then 0 else if v_x_0 < 0 then 2 else undefined"
-
-decideWithIfs2 :: String
-decideWithIfs2 =
-  [i|
-GIVEN x
-DECIDE f x IS 1 IF x > 0;
-       f x IS 0 OTHERWISE;
-       f x IS 2 IF x < 0
-|]
-
--- >>> transpileRulePure decideWithAttributes
--- "let f_f_1 = fun(v_x_0) => let v_y_2 = {s_p_4 = v_x_0 + v_x_0,s_z_3 = 0} in v_y_2"
-
-decideWithAttributes :: String
-decideWithAttributes =
-  [i|
-GIVEN x
-DECIDE f x IS y
-WHERE
-  y's z IS 0;
-  y's p IS SUM(x, x)
-|]
-
--- >>> transpileRulePure decideWithSimpleConditionalAttributes
--- "let f_f_1 = fun(v_x_0) => let v_y_2 = {s_z_3 = if v_x_0 > 3 then 5 else undefined} in v_y_2"
-
-decideWithSimpleConditionalAttributes :: String
-decideWithSimpleConditionalAttributes =
-  [i|
-GIVEN x
-DECIDE f x IS y
-WHERE
-  y's z IS 5 IF x > 3
-|]
-
--- >>> transpileRulePure decideWithConditionalAttributes
--- "let f_f_1 = fun(v_x_0) => let v_y_2 = {s_p_4 = if v_x_0 > 5 then v_x_0 else if b_OTHERWISE_5 then v_x_0 + v_x_0 else undefined,s_z_3 = if v_x_0 > 3 then 5 else if b_OTHERWISE_5 then 0 else undefined} in v_y_2"
-
-decideWithConditionalAttributes :: String
-decideWithConditionalAttributes =
-  [i|
-GIVEN x
-DECIDE f x IS y
-WHERE
-  y's z IS 5 IF x > 3;
-  y's z IS 0 OTHERWISE;
-
-  y's p IS x IF x > 5;
-  y's p IS SUM(x, x) OTHERWISE
-|]
-
--- let f = fun(x) =>
---    let y_z = if x > 5 then 5 else 0 in
---    let y_p = if x > 5 then x else sum(x, x) in
---    let y = { z = y_z, p = y_p } in
---    y
-
--- >>> transpileRulePure givethDefinition
--- "let v_y_0 = {s_z_1 = 5}"
-
-givethDefinition :: String
-givethDefinition =
-  [i|
-GIVETH y
-DECIDE y's z IS 5
-|]
-
--- >>> transpileRulePure givethNestedDefinition
--- "let v_y_0 = {s_a_1 = {s_b_2 = {s_c_3 = {s_z_4 = 5}}}}"
-
-givethNestedDefinition :: String
-givethNestedDefinition =
-  [i|
-GIVETH y
-DECIDE y's a's b's c's z IS 5
-|]
-
--- >>> transpileRulePure eragonBookDescription
--- "let v_eragon_0 = {s_character_3 = {s_friend_6 = 'Ork,s_main_4 = 'Eragon,s_villain_5 = 'Galbatorix},s_size_2 = 512,s_title_1 = 'Eragon}"
-
-eragonBookDescription :: String
-eragonBookDescription =
-  [i|
-GIVETH eragon
-DECIDE
-  eragon's title IS Eragon;
-  eragon's size IS 512;
-  eragon's character's main IS "Eragon";
-  eragon's character's villain IS "Galbatorix";
-  eragon's character's friend IS "Ork"
-|]
-
--- >>> transpileRulePure eragonBookDescriptionWithWhere
--- "let v_eragon_0 = let v_localVar_1 = {s_character_4 = {s_friend_7 = 'Ork,s_main_5 = 'Eragon,s_villain_6 = 'Galbatorix},s_size_3 = 512,s_title_2 = 'Eragon} in v_localVar_1"
-
-eragonBookDescriptionWithWhere :: String
-eragonBookDescriptionWithWhere =
-  [i|
-GIVETH eragon
-DECIDE
-  eragon IS localVar
-WHERE
-  localVar's title IS "Eragon";
-  localVar's size IS 512;
-  localVar's character's main IS "Eragon";
-  localVar's character's villain IS "Galbatorix";
-  localVar's character's friend IS "Ork"
-|]
-
--- >>> transpileRulePure noGivethDefinitionShouldFail
--- "let v_y_0 = {s_z_1 = 5}"
---
--- TODO: renamer fail, y is unknown, needs to fail!
-noGivethDefinitionShouldFail :: String
-noGivethDefinitionShouldFail =
-  [i|
-DECIDE y's z IS 5
-|]
-
--- >>> transpileRulePure noGivethSimpleDefinitionShouldFail
--- "let v_y_0 = 5"
---
--- TODO: renamer fail, y is unknown, needs to fail!
-noGivethSimpleDefinitionShouldFail :: String
-noGivethSimpleDefinitionShouldFail =
-  [i|
-DECIDE y IS 5
-|]
-
--- >>> transpileRulePure rodentsAndVermin
--- "Unsupported relational predicate: RPis"
---
-rodentsAndVermin :: String
-rodentsAndVermin =
-  [i|
-§ "Rodents and vermin"
-DECIDE "Not Covered"
-IF
-   UNLESS ( "Loss or Damage" IS ANY ( "caused by rodents"
-                                    , "caused by insects"
-                                    , "caused by vermin"
-                                    , "caused by birds"
-                                    )
-
-          , ANY ( ALL ( "Loss or Damage" IS "to Contents"
-                      , "Loss or Damage" IS "caused by birds"
-                      )
-
-                , UNLESS ( "Loss or Damage" IS "ensuing covered loss"
-
-                         , ANY ( "any other exclusion applies"
-                               , "an animal caused water to escape from"
-                                    ANY ( "a household appliance"
-                                        , "a swimming pool"
-                                        , "a plumbing, heating, or air conditioning system" )
-                               )
-                         )
-                )
-        )
-|]
+      name = fst $ NE.head assignment
+      rowRhsExprs = fmap snd $ NE.toList assignment
+    recordRows <- traverse assertIsRecord rowRhsExprs
+    mergedRows <- mergeRecordUpdates recordRows
+    pure (name, mergedRows)
 
 -- ----------------------------------------------------------------------------
 -- Debugger helpers

From 3c9f879ac565951629350a4781df4ad99f8eda11 Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Tue, 13 Aug 2024 13:52:08 +0200
Subject: [PATCH 27/44] Emit Simala Decls

---
 lib/haskell/cabal.project                     |  6 +++-
 lib/haskell/natural4/src/LS/Renamer.hs        |  2 +-
 .../natural4/src/LS/XPile/Simala/Transpile.hs | 29 +++++++++----------
 .../natural4/test/LS/XPile/SimalaSpec.hs      |  2 +-
 .../xpile/simala/calls-another.expected       |  1 -
 .../xpile/simala/calls-functions.expected     |  3 +-
 .../eragon-book-with-attributes.expected      |  2 +-
 .../golden/xpile/simala/eragon-book.expected  |  2 +-
 .../golden/xpile/simala/function-id.expected  |  2 +-
 .../simala/function-nested-builtins.expected  |  2 +-
 .../simala/function-nested-selector.expected  |  2 +-
 .../xpile/simala/function-record.expected     |  2 +-
 .../xpile/simala/function-selector.expected   |  2 +-
 .../golden/xpile/simala/function-sum.expected |  2 +-
 .../function-with-attributes-1.expected       |  2 +-
 ...on-with-attributes-conditionals-1.expected |  2 +-
 ...on-with-attributes-conditionals-2.expected |  2 +-
 .../function-with-conditionals-1.expected     |  2 +-
 .../function-with-conditionals-2.expected     |  2 +-
 .../function-with-conditionals-3.expected     |  2 +-
 .../golden/xpile/simala/functions.expected    |  3 +-
 .../simala/giveth-record-nested.expected      |  2 +-
 .../xpile/simala/giveth-record.expected       |  2 +-
 .../golden/xpile/simala/giveth.expected       |  2 +-
 .../no-giveth-adhoc-y-attribute.expected      |  2 +-
 .../xpile/simala/no-giveth-adhoc-y.expected   |  2 +-
 lib/haskell/stack.yaml                        |  4 ++-
 lib/haskell/stack.yaml.lock                   | 11 +++++++
 28 files changed, 57 insertions(+), 42 deletions(-)
 delete mode 100644 lib/haskell/natural4/test/testdata/golden/xpile/simala/calls-another.expected

diff --git a/lib/haskell/cabal.project b/lib/haskell/cabal.project
index a8aea9856..1bfcf3201 100644
--- a/lib/haskell/cabal.project
+++ b/lib/haskell/cabal.project
@@ -2,7 +2,6 @@ packages:
   ./natural4
   ./anyall
   ./explainable
-  ../../../simala
 
 -- Environment files are required to run the doctests via `cabal test doctests`
 write-ghc-environment-files: always
@@ -28,6 +27,11 @@ source-repository-package
   location: https://github.com/anka-213/haskell-wordnet
   tag: a6d675bcbe1585fc652f95f60e0dec826a660646
 
+source-repository-package
+  type: git
+  location: https://github.com/smucclaw/simala
+  tag: ca666a3b7155f306a9240a787910a2738b464f60
+
 allow-newer:
   compact:*,
   udpipe-hs:base,
diff --git a/lib/haskell/natural4/src/LS/Renamer.hs b/lib/haskell/natural4/src/LS/Renamer.hs
index c40b0a0bb..798ded902 100644
--- a/lib/haskell/natural4/src/LS/Renamer.hs
+++ b/lib/haskell/natural4/src/LS/Renamer.hs
@@ -396,7 +396,7 @@ data MultiTermContext = MultiTermContext
   -- the 'multiTermContextInSelector' is set expected to be to 'True', so that
   -- we can infer that @"title"@ is a 'RnSelector'.
   , _multiTermContextFunctionCall :: Maybe RnName
-  -- ^ During renaming a 'MultiTerm', did we encounter a function application?
+  -- ^ While renaming a 'MultiTerm', did we encounter a function application?
   -- If so, we want to fix the call convention from infix/postfix to prefix!
   }
 
diff --git a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
index 9b02c5473..a64260910 100644
--- a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
+++ b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
@@ -107,21 +107,18 @@ newtype Transpiler a = Transpiler {runTranspiler :: Except String a}
   deriving newtype (Functor, Applicative, Monad)
   deriving newtype (MonadError String)
 
-transpile :: [RnRule] -> Transpiler Simala.Expr
+transpile :: [RnRule] -> Transpiler [Simala.Decl]
 transpile rules = do
   simalaTerms <- Maybe.catMaybes <$> traverse ruleToSimala rules
-  combineSimalaTerms Simala.Undefined simalaTerms
-
-combineSimalaTerms :: Simala.Expr -> [SimalaTerm] -> Transpiler Simala.Expr
-combineSimalaTerms inExpr [] = pure inExpr
-combineSimalaTerms inExpr (TermLetIn t name expr : terms) = do
-  restOfInExpr <- combineSimalaTerms inExpr terms
-  pure $ mkLetIn t name expr restOfInExpr
-combineSimalaTerms inExpr (TermFunction t name params expr : terms) = do
-  restOfInExpr <- combineSimalaTerms inExpr terms
-  pure $ mkFunction t name params expr restOfInExpr
-combineSimalaTerms _inExpr _terms = do
-  throwError $ "combineSimalaTerms: Cannot combine SimalaTerms: " <> show _terms
+  traverse toSimalaDecl simalaTerms
+
+toSimalaDecl :: SimalaTerm -> Transpiler Simala.Decl
+toSimalaDecl (TermLetIn t name expr) = do
+  pure $ Simala.NonRec t name expr
+toSimalaDecl (TermFunction t name params expr) = do
+  pure $ Simala.NonRec t name $ mkFunctionDecl t params expr
+toSimalaDecl _term = do
+  throwError $ "toSimalaDecl: Cannot convert SimalaTerms to Decl: " <> show _term
 
 -- ----------------------------------------------------------------------------
 -- Main translation helpers
@@ -780,8 +777,8 @@ debugTranspileRule ruleSrc = do
       TL.putStrLn $ Pretty.pShow rnRule
       case runExcept $ runTranspiler $ transpile [rnRule] of
         Left err -> putStrLn err
-        Right expr -> do
-          Text.putStrLn $ "Expr: " <> Simala.render expr
+        Right decls -> flip Foldable.traverse_ decls $ \decl -> do
+          Text.putStrLn $ "Decl: " <> Simala.render decl
 
 transpileRulePure :: String -> Text
 transpileRulePure ruleSrc =
@@ -793,7 +790,7 @@ transpileRulePure ruleSrc =
         case runExcept $ runTranspiler $ transpile [rnRule] of
           Left err -> Text.pack err
           Right expr ->
-            Simala.render expr
+            Text.unlines $ fmap Simala.render expr
 
 run :: String -> Either String LS.Rule
 run = fmap Parser.transRule . Parser.pRule . Parser.myLexer
diff --git a/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs b/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
index da587b673..929909a12 100644
--- a/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
+++ b/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
@@ -251,7 +251,7 @@ transpilerTest outputName ruleString = it outputName $
           (Right rnRules, _) -> do
             case runExcept (Simala.runTranspiler $ Simala.transpile rnRules) of
               Left err -> "Failed transpilation:\n" <> err
-              Right simala -> Text.unpack $ Simala.render simala
+              Right simalaDecls -> Text.unpack $ Text.unlines $ fmap Simala.render simalaDecls
 
 goldenGeneric :: String -> String -> Golden TL.Text
 goldenGeneric name output_ =
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/calls-another.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/calls-another.expected
deleted file mode 100644
index c8c2c5155..000000000
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/calls-another.expected
+++ /dev/null
@@ -1 +0,0 @@
-let f_f_1 = fun (v_x_0) => v_x_0 in let f_g_3 = fun (v_x_2) => f_f_1(v_x_2) in undefined
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/calls-functions.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/calls-functions.expected
index c8c2c5155..a3c4b97a4 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/calls-functions.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/calls-functions.expected
@@ -1 +1,2 @@
-let f_f_1 = fun (v_x_0) => v_x_0 in let f_g_3 = fun (v_x_2) => f_f_1(v_x_2) in undefined
\ No newline at end of file
+ f_f_1 = fun (v_x_0) => v_x_0
+ f_g_3 = fun (v_x_2) => f_f_1(v_x_2)
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/eragon-book-with-attributes.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/eragon-book-with-attributes.expected
index ad0aa5431..1ed08b906 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/eragon-book-with-attributes.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/eragon-book-with-attributes.expected
@@ -1 +1 @@
-let v_eragon_0 = let v_localVar_1 = {s_character_4 = {s_friend_7 = 'Ork,s_main_5 = 'Eragon,s_villain_6 = 'Galbatorix},s_size_3 = 512,s_title_2 = 'Eragon} in v_localVar_1 in undefined
\ No newline at end of file
+ v_eragon_0 = let v_localVar_1 = {s_character_4 = {s_friend_7 = 'Ork,s_main_5 = 'Eragon,s_villain_6 = 'Galbatorix},s_size_3 = 512,s_title_2 = 'Eragon} in v_localVar_1
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/eragon-book.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/eragon-book.expected
index 4f623247b..6934fcafe 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/eragon-book.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/eragon-book.expected
@@ -1 +1 @@
-let v_eragon_0 = {s_character_3 = {s_friend_6 = 'Ork,s_main_4 = 'Eragon,s_villain_5 = 'Galbatorix},s_size_2 = 512,s_title_1 = 'Eragon} in undefined
\ No newline at end of file
+ v_eragon_0 = {s_character_3 = {s_friend_6 = 'Ork,s_main_4 = 'Eragon,s_villain_5 = 'Galbatorix},s_size_2 = 512,s_title_1 = 'Eragon}
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-id.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-id.expected
index f0d384bb5..1f6ddbe38 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-id.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-id.expected
@@ -1 +1 @@
-let f_id_1 = fun (v_x_0) => v_x_0 in undefined
\ No newline at end of file
+ f_id_1 = fun (v_x_0) => v_x_0
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-nested-builtins.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-nested-builtins.expected
index 51ce3a355..3392e175b 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-nested-builtins.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-nested-builtins.expected
@@ -1 +1 @@
-let f_discounted_by_3 = fun (v_x_0,v_y_2) => v_x_0 + (1 - v_y_2) in undefined
\ No newline at end of file
+ f_discounted_by_3 = fun (v_x_0,v_y_2) => v_x_0 + (1 - v_y_2)
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-nested-selector.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-nested-selector.expected
index 0b45ad9dc..4af1cd78b 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-nested-selector.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-nested-selector.expected
@@ -1 +1 @@
-let f_f_1 = fun (v_x_0) => v_x_0.s_y_2.s_z_3 in undefined
\ No newline at end of file
+ f_f_1 = fun (v_x_0) => v_x_0.s_y_2.s_z_3
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-record.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-record.expected
index ebf050b21..64663ee85 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-record.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-record.expected
@@ -1 +1 @@
-let f_g_1 = fun (v_d_0) => let v_y_2 = {s_book_3 = if v_d_0 > 0 then 'green else if b_OTHERWISE_4 then 'red else undefined} in v_y_2 in undefined
\ No newline at end of file
+ f_g_1 = fun (v_d_0) => let v_y_2 = {s_book_3 = if v_d_0 > 0 then 'green else if b_OTHERWISE_4 then 'red else undefined} in v_y_2
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-selector.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-selector.expected
index 081f261c0..0f0ff6444 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-selector.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-selector.expected
@@ -1 +1 @@
-let f_f_1 = fun (v_x_0) => v_x_0.s_z_2 in undefined
\ No newline at end of file
+ f_f_1 = fun (v_x_0) => v_x_0.s_z_2
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-sum.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-sum.expected
index 7df24734e..86cd9adbd 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-sum.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-sum.expected
@@ -1 +1 @@
-let f_sum3_1 = fun (v_x_0) => sum(v_x_0,v_x_0,v_x_0) in undefined
\ No newline at end of file
+ f_sum3_1 = fun (v_x_0) => sum(v_x_0,v_x_0,v_x_0)
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-1.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-1.expected
index 9b3f5748f..fc6d22443 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-1.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-1.expected
@@ -1 +1 @@
-let f_f_1 = fun (v_x_0) => let v_y_2 = {s_p_4 = v_x_0 + v_x_0,s_z_3 = 0} in v_y_2 in undefined
\ No newline at end of file
+ f_f_1 = fun (v_x_0) => let v_y_2 = {s_p_4 = v_x_0 + v_x_0,s_z_3 = 0} in v_y_2
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-conditionals-1.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-conditionals-1.expected
index b7f5dea8f..3fe94607d 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-conditionals-1.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-conditionals-1.expected
@@ -1 +1 @@
-let f_f_1 = fun (v_x_0) => let v_y_2 = {s_z_3 = if v_x_0 > 3 then 5 else undefined} in v_y_2 in undefined
\ No newline at end of file
+ f_f_1 = fun (v_x_0) => let v_y_2 = {s_z_3 = if v_x_0 > 3 then 5 else undefined} in v_y_2
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-conditionals-2.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-conditionals-2.expected
index ee09363ae..deb4adfef 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-conditionals-2.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-conditionals-2.expected
@@ -1 +1 @@
-let f_f_1 = fun (v_x_0) => let v_y_2 = {s_p_4 = if v_x_0 > 5 then v_x_0 else if b_OTHERWISE_5 then v_x_0 + v_x_0 else undefined,s_z_3 = if v_x_0 > 3 then 5 else if b_OTHERWISE_5 then 0 else undefined} in v_y_2 in undefined
\ No newline at end of file
+ f_f_1 = fun (v_x_0) => let v_y_2 = {s_p_4 = if v_x_0 > 5 then v_x_0 else if b_OTHERWISE_5 then v_x_0 + v_x_0 else undefined,s_z_3 = if v_x_0 > 3 then 5 else if b_OTHERWISE_5 then 0 else undefined} in v_y_2
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-1.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-1.expected
index a292c1520..ff2657cea 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-1.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-1.expected
@@ -1 +1 @@
-let f_f_1 = fun (v_x_0) => if v_x_0 > 0 then 1 else if b_OTHERWISE_2 then 0 else if v_x_0 < 0 then 2 else undefined in undefined
\ No newline at end of file
+ f_f_1 = fun (v_x_0) => if v_x_0 > 0 then 1 else if b_OTHERWISE_2 then 0 else if v_x_0 < 0 then 2 else undefined
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-2.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-2.expected
index 34b12ad2d..610e4c2d2 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-2.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-2.expected
@@ -1 +1 @@
-let f_f_1 = fun (v_x_0) => if v_x_0 > 0 then 1 else if b_OTHERWISE_2 then 0 else undefined in undefined
\ No newline at end of file
+ f_f_1 = fun (v_x_0) => if v_x_0 > 0 then 1 else if b_OTHERWISE_2 then 0 else undefined
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-3.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-3.expected
index cf0f7cebb..9908af0dc 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-3.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-3.expected
@@ -1 +1 @@
-let f_f_1 = fun (v_x_0) => if v_x_0 > 0 then 1 else 0 in undefined
\ No newline at end of file
+ f_f_1 = fun (v_x_0) => if v_x_0 > 0 then 1 else 0
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/functions.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/functions.expected
index aeea5b5f1..595e22922 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/functions.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/functions.expected
@@ -1 +1,2 @@
-let f_f_1 = fun (v_x_0) => v_x_0 in let f_g_3 = fun (v_x_2) => v_x_2 in undefined
\ No newline at end of file
+ f_f_1 = fun (v_x_0) => v_x_0
+ f_g_3 = fun (v_x_2) => v_x_2
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth-record-nested.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth-record-nested.expected
index 562a37d52..285df743a 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth-record-nested.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth-record-nested.expected
@@ -1 +1 @@
-let v_y_0 = {s_a_1 = {s_b_2 = {s_c_3 = {s_z_4 = 5}}}} in undefined
\ No newline at end of file
+ v_y_0 = {s_a_1 = {s_b_2 = {s_c_3 = {s_z_4 = 5}}}}
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth-record.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth-record.expected
index 93dc6029f..8a82b8773 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth-record.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth-record.expected
@@ -1 +1 @@
-let v_y_0 = {s_z_1 = 5} in undefined
\ No newline at end of file
+ v_y_0 = {s_z_1 = 5}
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth.expected
index 6b3978e79..b2ebdcb68 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/giveth.expected
@@ -1 +1 @@
-let v_x_0 = let v_y_1 = 5 in v_y_1 in undefined
\ No newline at end of file
+ v_x_0 = let v_y_1 = 5 in v_y_1
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/no-giveth-adhoc-y-attribute.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/no-giveth-adhoc-y-attribute.expected
index 93dc6029f..8a82b8773 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/no-giveth-adhoc-y-attribute.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/no-giveth-adhoc-y-attribute.expected
@@ -1 +1 @@
-let v_y_0 = {s_z_1 = 5} in undefined
\ No newline at end of file
+ v_y_0 = {s_z_1 = 5}
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/no-giveth-adhoc-y.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/no-giveth-adhoc-y.expected
index c1853c8c1..70b656b83 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/no-giveth-adhoc-y.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/no-giveth-adhoc-y.expected
@@ -1 +1 @@
-let v_y_0 = 5 in undefined
\ No newline at end of file
+ v_y_0 = 5
diff --git a/lib/haskell/stack.yaml b/lib/haskell/stack.yaml
index 3ab9707e5..7b0ead7f4 100644
--- a/lib/haskell/stack.yaml
+++ b/lib/haskell/stack.yaml
@@ -13,7 +13,6 @@ packages:
 - natural4
 - anyall
 - explainable
-- ../../../simala
 
 extra-deps:
 # if you are actively developing both baby-l4 and the natural4 code that uses it (import L4.*)
@@ -32,6 +31,9 @@ extra-deps:
 - github: anka-213/haskell-wordnet
   commit: a6d675bcbe1585fc652f95f60e0dec826a660646
 
+- github: smucclaw/simala
+  commit: ca666a3b7155f306a9240a787910a2738b464f60
+
 - monad-validate-1.3.0.0
 - simple-smt-0.9.7
 - diagnose-2.5.1
diff --git a/lib/haskell/stack.yaml.lock b/lib/haskell/stack.yaml.lock
index b36bc2ed8..2e4216270 100644
--- a/lib/haskell/stack.yaml.lock
+++ b/lib/haskell/stack.yaml.lock
@@ -48,6 +48,17 @@ packages:
     version: 0.1.1.0
   original:
     url: https://github.com/anka-213/haskell-wordnet/archive/a6d675bcbe1585fc652f95f60e0dec826a660646.tar.gz
+- completed:
+    name: simala
+    pantry-tree:
+      sha256: 5aeda5482faee42502897d077389e7fcfb29d3ea961e9429ea1a0a900721647a
+      size: 2422
+    sha256: 11235aef474590cd11d77369c9ccacb65cb3b1b24b3048873bccb889d91794e5
+    size: 16142
+    url: https://github.com/smucclaw/simala/archive/ca666a3b7155f306a9240a787910a2738b464f60.tar.gz
+    version: '0.1'
+  original:
+    url: https://github.com/smucclaw/simala/archive/ca666a3b7155f306a9240a787910a2738b464f60.tar.gz
 - completed:
     hackage: monad-validate-1.3.0.0@sha256:eb6ddd5c9cf72ff0563cba604fa00291376e96138fdb4932d00ff3a99d66706e,2605
     pantry-tree:

From 51d489eac3efc19ac0260d35f1de351c667dc458 Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Tue, 13 Aug 2024 14:31:46 +0200
Subject: [PATCH 28/44] Cleanup incidental changes

---
 lib/haskell/example-progs.md         | 329 ---------------------------
 lib/haskell/natural4/bnfc/Main.hs    |  54 ++---
 lib/haskell/natural4/src/LS/Types.hs |  10 -
 3 files changed, 13 insertions(+), 380 deletions(-)
 delete mode 100644 lib/haskell/example-progs.md

diff --git a/lib/haskell/example-progs.md b/lib/haskell/example-progs.md
deleted file mode 100644
index ed987975c..000000000
--- a/lib/haskell/example-progs.md
+++ /dev/null
@@ -1,329 +0,0 @@
-# Discuss and look at various hornlike rules
-
-* What's the rule-name for?
-* How is the rule-name determined?
-
-## Functions and constants
-
-```
-GIVEN d DECIDE g d IS y
-WHERE
-    y's book IS green IF d > 0;
-    y's book IS red OTHERWISE
-```
-
-Simple function
-Corresponds to the function:
-
-> g :: Int -> { book: 'red | 'green }
-> g d = if d > 0 then { book: green} else { book: red }
-
-Or the simala function:
-
-> g = fun (d) => if d > 0 then { book = 'green } else { book = 'red }
-
-**Question**
-
-Is this function equivalent? Or is this a constant?
-
-```
-GIVEN d
-GIVETH y
-DECIDE
-    y's book IS green IF d > 0;
-    y's book's size IS g z OTHERWISE
-WHERE
-    z IS 5
-    g d IS 5
-
-
-GIVETH d
-DECIDE d IS 5;
-```
-
-The generic mathlang translation seems to turn this one into:
-
-```
-[ param d, param y.green, param y.red
-, y = true
-, if d > 0 then y.book = green
-, if true then y.book = red
-]
-```
-
-In short, this shouldn't work, as this rule doesn't have a name and is thus unusable.
-
-Or is `y` a global variable? It can't be in this instance, but what about
-
-```
-GIVETH y
-DECIDE y
-WHERE
-    y's book IS green IF d > 0;
-    y's book IS red OTHERWISE
-```
-
-Would that be supposed to work?
-
-**ANSWER**
-
-As `d` can be inferred as a global variable, we are thinking of a new keyword, such as `WITH` or `ASSUME`.
-
-```
-ASSUME d
-GIVETH y
-WHERE
-    y's book IS 'green IF d > 0;
-    y's book IS 'red OTHERWISE
-```
-
-Translates to:
-
-> let d = ... : Int
-> in let y = if d > 0 then { book: 'green } else { book: 'red }
-
-### Declarations
-
-**Valid definition**
-
-Prefix (1 arg)
-
-```
-GIVEN x
-DECIDE f x IS SUM(x, 3)
-```
-
-Postfix
-
-```
-GIVEN x
-DECIDE x f IS SUM(x, 3)
-```
-
-Prefix (2 args)
-
-```
-GIVEN x, y
-DECIDE f x y IS SUM(x, 3)
-```
-
-Infix (2 args)
-
-```
-GIVEN x, y
-DECIDE x f y IS SUM(x, 3)
-```
-
-**Invalid definition**
-
-`y` is bound in where, that's not allowed.
-
-```
-GIVEN x
-DECIDE f x y IS SUM(x, y)
-WHERE y IS 5
-```
-
-`d` is a global variable, not allowed in function definition
-
-```
-GIVEN x
-DECIDE f x d IS SUM(x, d)
-```
-
-
-## GIVEN and GIVETHS
-
-```
-GIVETH x, y
-DECIDE
-    x IS 5;
-    y IS 7
-```
-
-Is this two constants, or what is this supposed to mean?
-
-`GIVEN`s seem to be generally rather optional, are they simply variable declarations?
-
-**ANSWER**
-
-These are indeed two constants.
-
-## Name shadowing
-
-**In bnfc, rules are not allowed in WHERE**
-
-```
-GIVEN x IS A NUMBER
-DECIDE g x IS f x
-WHERE
-    GIVEN x DECIDE f x IS SUM(x, x)
-```
-
-## Functions
-
-Functions are of the form
-
-```
-GIVEN x [AS A type], y [IS ONE OF ...], ...
-DECIDE f x y ... IS <body>
-```
-
-As a concrete example
-
-```
-GIVEN x
-DECIDE f x IS 5
-```
-
-`f` is the function name, `x` the parameter and `5` is the function body.
-So the function `f` called with any parameter produces the result `5`.
-
-All parameters *must* be `GIVEN`s and occur on the lhs of `IS`.
-The name of the function, which must be free can occur for single parameters in
-either `Prefix` or `Postfix`, and for two parameters in `Prefix` or `Infix` notation.
-For anything else, the function must be in `Prefix` notation.
-
-E.g.
-
-* `f x`: Prefix
-* `x f`: Postfix
-* `x f y`: Infix
-* `f x y`: Prefix
-* `f a b c d ...`: Prefix.
-
-### Recursion
-
-Possible example:
-
-```
-GIVEN x
-DECIDE
-    f x IS SUM ( f MINUS ( x , 1 ) , f MINUS ( x , 1 ) ) IF x > 0;
-    f x IS 0 OTHERWISE
-```
-
-However, this fail to parse and the equivalent csv syntax also feels like it would not support this.
-
-## Inline Enums for GIVEN and GIVETH
-
-```
-GIVETH x IS ONE OF foo, bar, baz DECIDE x IS foo
-```
-
-Assign that x is some output
-
-> x :: foo | bar | baz
-> x = foo
-
-```
-GIVEN
-    y IS A NUMBER
-GIVETH
-    x IS ONE OF foo, bar, baz
-DECIDE
-    x IS foo IF y > 5;
-    x IS bar IF y < 0;
-    x IS baz OTHERWISE
-```
-
-Assign a value to the variable x based on the value of 'y'
-Should translate to:
-
-> x = \y -> if y > 5 then 'foo else if y < 0 then 'bar else 'baz
-
-```
-GIVEN x IS ONE OF foo, bar, baz
-DECIDE
-    foo x IS 5 IF x IS foo;
-    foo x IS 10 OTHERWISE
-```
-
-Assign that x is some output
-
-    foo :: foo | bar | baz -> Number
-    foo x = if x == foo
-           then 5
-           else 10
-
-```
-GIVEN x IS ONE OF foo, bar, baz;
-      y IS ONE OF foo, bar, baz
-DECIDE
-    foo x IS 5 IF x IS foo AND y IS foo;
-    foo x IS 10 OTHERWISE
-```
-
-Are x and y referring to the same type?
-What about:
-
-```
-GIVEN x IS ONE OF foo, bar, baz
-      y IS ONE OF foo, bar, foo baz
-```
-
-Are 'foo and 'bar the same type then?
-For now, enums can only be text and they are assumed to be globals.
-
-E.g., this is disallowed
-
-```
-GIVEN x IS ONE OF foo IS A NUMBER;
-      bar IS A NUMBER
-DECIDE f x IS 5
-```
-
-# Renaming
-
-How do we want to rename a program?
-Example programs:
-
-**Id Function**
-
-```
-GIVEN x
-DECIDE id x IS x
-```
-
-```
-GIVEN x1
-DECIDE id1 x1 IS x1
-```
-
-**Multiple Id Functions**
-
-```
-§ fun_0
-GIVEN x
-DECIDE id x IS x
-
-§ fun_1
-GIVEN x
-DECIDE id2 x IS x
-```
-
-```
-GIVEN x1
-DECIDE id1 x1 IS x1
-
-GIVEN x2
-DECIDE id12 x2 IS x2
-```
-
-Note, `id1` is renamed to `id12`.
-`GIVEN`s are renamed as they are local to the function.
-
-Scope Tree
-
-```
-* (1) id
-    * (2) x
-* (3) id
-    * (4) x
-```
-
-```
-* 1 (id)
-    * x
-* 2 (id)
-    *
diff --git a/lib/haskell/natural4/bnfc/Main.hs b/lib/haskell/natural4/bnfc/Main.hs
index 4b9b0ef82..45c3ae1a1 100644
--- a/lib/haskell/natural4/bnfc/Main.hs
+++ b/lib/haskell/natural4/bnfc/Main.hs
@@ -1,30 +1,21 @@
 -- File generated by the BNF Converter (bnfc 2.9.5).
 
 -- | Program to test parser.
+
 module Main where
 
-import Control.Monad (forM_, when)
-import Data.Function ((&))
-import Data.HashMap.Strict qualified as HM
-import Data.List (uncons)
+import System.Exit        ( exitFailure )
+import Control.Monad      ( when )
 import Data.Text.Lazy qualified as Text
-import Explainable
-import Explainable.MathLang
-import Explainable.MathLang qualified as Expl
-import LS.Rule (Interpreted (origrules), defaultL4I)
-import LS.XPile.MathLang.GenericMathLang.ToGenericMathLang
-import LS.XPile.MathLang.MathLang qualified as GML
-import System.Environment (getArgs)
-import System.Exit (exitFailure)
-import Text.Pretty.Simple (pShowNoColor)
 import TextuaL4.AbsTextuaL qualified as TL4
-import TextuaL4.LexTextuaL (Token, mkPosToken)
-import TextuaL4.ParTextuaL (myLexer, pRule)
 import TextuaL4.Transform
+import TextuaL4.LexTextuaL   ( Token, mkPosToken )
+import TextuaL4.ParTextuaL   ( pRule, myLexer )
+import Text.Pretty.Simple (pShowNoColor)
 
-type Err = Either String
+type Err        = Either String
 type ParseFun a = [Token] -> Err a
-type Verbosity = Int
+type Verbosity  = Int
 
 putStrV :: Verbosity -> String -> IO ()
 putStrV v s = when (v > 1) $ putStrLn s
@@ -45,35 +36,16 @@ run v p s =
       let l4tree = transRule tree
       putStrLn $ Text.unpack $ pShowNoColor l4tree
 
-
-      when (v >= 3) $ do
-        let
-          stuff = toMathLangGen $ defaultL4I{origrules = [l4tree]}
-          (stuff2, st0) = GML.toMathLang $ defaultL4I{origrules = [l4tree]}
-          st =
-            st0
-              { symtabF =
-                  symtabF st0
-                    & HM.insert "green" (Expl.Val Nothing 1.0)
-                    & HM.insert "red" (Expl.Val Nothing 2.0)
-                    & HM.insert "d" (Expl.Val Nothing 15.0)
-              }
-        putStrLn $ fst stuff
-        forM_ stuff2 $ \explExpr -> do
-          xplainE (mempty @()) st $ eval explExpr
-        pure ()
  where
   ts = myLexer s
-  showPosToken ((l, c), t) = concat [show l, ":", show c, "\t", show t]
+  showPosToken ((l,c),t) = concat [ show l, ":", show c, "\t", show t ]
 
 showTree :: (Show a) => Int -> a -> IO ()
 showTree v tree = do
   putStrV v $ "\n[Abstract Syntax]\n\n" ++ show tree
 
+
 main :: IO ()
-main = do
-  xs <- getArgs
-  let v = case uncons xs of
-        Nothing -> 2
-        Just (x, _) -> read x
-  getContents >>= run v pRule
+main = getContents >>= run 2 pRule
+
+
diff --git a/lib/haskell/natural4/src/LS/Types.hs b/lib/haskell/natural4/src/LS/Types.hs
index 0ba23b716..f042b2b81 100644
--- a/lib/haskell/natural4/src/LS/Types.hs
+++ b/lib/haskell/natural4/src/LS/Types.hs
@@ -57,16 +57,6 @@ data MTExpr = MTT Text.Text -- ^ Text string
 --            | MTD Text.Text -- ^ Date
             deriving (Eq, Ord, Show, Generic, Hashable, ToJSON)
 
--- GIVEN x
--- DECIDE f x IS y
--- WHERE  y's book's color IS 'green
-
--- let f = fun(x) => { book = { color = 'green } }
-
--- [ MTT x's, MTT book's, MTT color ]
--- [ RnVariable x, RnSelector book, RnSelector color]
--- [ x.book.color ]
-
 makePrisms ''MTExpr
 
 type PlainParser = ReaderT RunConfig (Parsec Void MyStream)

From 69c88fde42238d244aa88ac26015c74d7ff79a51 Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Tue, 13 Aug 2024 15:43:26 +0200
Subject: [PATCH 29/44] Add typed errors to renamer phase

---
 lib/haskell/natural4/src/LS/Renamer.hs        | 206 ++++++++++++------
 lib/haskell/natural4/test/LS/RenamerSpec.hs   |   7 +-
 .../natural4/test/LS/XPile/SimalaSpec.hs      |  29 +--
 3 files changed, 156 insertions(+), 86 deletions(-)

diff --git a/lib/haskell/natural4/src/LS/Renamer.hs b/lib/haskell/natural4/src/LS/Renamer.hs
index 798ded902..cf54d1848 100644
--- a/lib/haskell/natural4/src/LS/Renamer.hs
+++ b/lib/haskell/natural4/src/LS/Renamer.hs
@@ -15,22 +15,27 @@ module LS.Renamer (
   RnRule (..),
   RnHornlike (..),
   RnTypeDecl (..),
-  RnHornClause(..),
-  RnTypedMulti(..),
+  RnHornClause (..),
+  RnTypedMulti (..),
   RnMultiTerm,
-  RnExpr(..),
-  RnName(..),
-  RnNameType(..),
-  RnLit(..),
-  RnRelationalPredicate(..),
+  RnExpr (..),
+  RnName (..),
+  RnNameType (..),
+  RnLit (..),
+  RnRelationalPredicate (..),
   RnBoolStructR,
   OccName,
   Unique,
   mkSimpleOccName,
+
   -- * Renamer Monad and runners
-  Renamer(..),
+  Renamer (..),
   runRenamerFor,
 
+  -- * Renamer Errors
+  RenamerError (..),
+  renderRenamerError,
+
   -- * Scope checking types
   Scope (..),
   scScopeTable,
@@ -49,10 +54,12 @@ module LS.Renamer (
   differenceScopeTable,
   emptyScopeTable,
   FuncInfo (..),
+
   -- * Assertion helpers
   assertEmptyList,
   assertSingletonMultiTerm,
   assertNoTypeSignature,
+
   -- * Debugging helpers
   renameRuleTopLevel,
 ) where
@@ -63,7 +70,7 @@ import LS.Rule qualified as Rule
 import LS.Types (MyToken, RuleName, SrcRef)
 import LS.Types qualified as LS
 
-import Control.Monad.Error.Class
+import Control.Monad.Error.Class as Error
 import Control.Monad.Extra (foldM, fromMaybeM)
 import Control.Monad.State.Strict (MonadState)
 import Control.Monad.Trans.Except (ExceptT)
@@ -81,6 +88,7 @@ import Data.Map.Strict qualified as Map
 import Data.Set qualified as Set
 import Data.Text (Text)
 import Data.Text qualified as Text
+import Data.Text.IO qualified as Text
 import Data.Text.Lazy.IO qualified as TL
 import GHC.Generics (Generic)
 import Optics hiding (has)
@@ -203,13 +211,86 @@ data RnRelationalPredicate
   | RnNary LS.RPRel [RnRelationalPredicate]
   deriving (Eq, Ord, Show, Generic)
 
+-- ----------------------------------------------------------------------------
+-- Typed Errors
+-- ----------------------------------------------------------------------------
+
+data RenamerError
+  = UnsupportedRule Text Rule
+  | UnsupportedRPParamText LS.ParamText
+  | UnsupportedUpon LS.ParamText
+  | UnknownMultiTerms LS.MultiTerm
+  | FixArityFunctionNotFound RnName [RnExpr]
+  | ArityErrorLeft !Int RnName [RnExpr]
+  | ArityErrorRight !Int RnName [RnExpr]
+  | -- Scope Error
+    UnexpectedNameNotFound OccName
+  | UnexpectedRnNameNotFound RnName
+  | InsertNameUnexpectedType RnNameType RnNameType
+  | LookupOrInsertNameUnexpectedType RnNameType RnNameType
+  | -- Validation Errors
+    forall a. (Show a) => UnexpectedNonEmptyList [a]
+  | forall a f. (Show (f a), Foldable f) => UnexpectedNonSingletonList (f a)
+  | UnexpectedTypeSignature LS.TypedMulti
+
+renderRenamerError :: RenamerError -> Text.Text
+renderRenamerError = \case
+  UnsupportedRule herald r -> herald <> ": Unsupported rule: " <> Text.pack (show r)
+  UnsupportedRPParamText rp -> "Received 'RPParamText', we can't handle that yet. Got: " <> Text.pack (show rp)
+  UnsupportedUpon pText -> "Clause \"UPON\" is currently unsupported: " <> Text.pack (show pText)
+  UnknownMultiTerms mts -> "While scanning a multi term in a top-level DECIDE clause, we encountered an unsupported pattern: " <> Text.pack (show mts)
+  FixArityFunctionNotFound name list ->
+    "Invariant violated, function " <> Text.pack (show name) <> " reported, but not found in " <> Text.pack (show list)
+  ArityErrorLeft expected name list ->
+    "Not enough elements in left hand side of function "
+      <> Text.pack (show name)
+      <> ". Required: "
+      <> Text.pack (show expected)
+      <> " but got: "
+      <> Text.pack (show (length list))
+      <> " ("
+      <> Text.pack (show list)
+      <> ")"
+  ArityErrorRight expected name list ->
+    "Not enough elements in right hand side of function "
+      <> Text.pack (show name)
+      <> ". Required: "
+      <> Text.pack (show expected)
+      <> " but got: "
+      <> Text.pack (show (length list))
+      <> " ("
+      <> Text.pack (show list)
+      <> ")"
+  -- Scope Error
+  UnexpectedNameNotFound occName ->
+    "Assumption violated, OccName not found: " <> Text.pack (show occName)
+  UnexpectedRnNameNotFound rnName ->
+    "Assumption violated, RnName not found: " <> Text.pack (show rnName)
+  InsertNameUnexpectedType expected actual ->
+    "Invariant violated, trying to insert an incorrect RnNameType for a resolved name. Got: "
+      <> Text.pack (show actual)
+      <> " but expected: "
+      <> Text.pack (show expected)
+  LookupOrInsertNameUnexpectedType expected actual ->
+    "Invariant violated, trying to insert or lookup an incorrect RnNameType for a resolved name. Got: "
+      <> Text.pack (show actual)
+      <> " but expected: "
+      <> Text.pack (show expected)
+  -- Validation Errrors
+  UnexpectedNonEmptyList xs ->
+    "Expected an empty list, but got: " <> Text.pack (show xs)
+  UnexpectedNonSingletonList xs ->
+    "Expected an singleton list, but got: " <> Text.pack (show xs)
+  UnexpectedTypeSignature tm ->
+    "Expected no type signature, but got: " <> Text.pack (show tm)
+
 -- ----------------------------------------------------------------------------
 -- Scope tables
 -- ----------------------------------------------------------------------------
 
-newtype Renamer a = Renamer {runRenamer :: ExceptT String (State Scope) a}
+newtype Renamer a = Renamer {runRenamer :: ExceptT RenamerError (State Scope) a}
   deriving newtype (Functor, Applicative, Monad)
-  deriving newtype (MonadState Scope, MonadError String)
+  deriving newtype (MonadState Scope, MonadError RenamerError)
 
 type Unique = Int
 
@@ -275,7 +356,6 @@ makeFieldsNoPrefix 'Scope
 makeFieldsNoPrefix 'ScopeTable
 makeFieldsNoPrefix 'FuncInfo
 
-
 emptyScope :: Scope
 emptyScope =
   Scope
@@ -305,15 +385,11 @@ lookupExistingName :: OccName -> RnNameType -> Renamer RnName
 lookupExistingName occName nameType = do
   mRnName <- lookupName occName
   case mRnName of
-    Nothing -> throwError $ "lookupExistingName: Assumptions violated, name wasn't found: " <> show occName
+    Nothing -> throwError $ UnexpectedNameNotFound occName
     Just name
       | name.rnNameType == nameType -> pure name
       | otherwise ->
-          throwError $
-            "lookupExistingName: Invariant violated, trying to insert a different name type for a name that's already known. Got: "
-              <> show nameType
-              <> " but expected: "
-              <> show (rnNameType name)
+          throwError $ InsertNameUnexpectedType (rnNameType name) nameType
 
 -- | Either inserts a new name of the given type, or checks that the name
 -- is already in scope with the given type.
@@ -326,11 +402,7 @@ lookupOrInsertName occName nameType =
     Just name
       | rnNameType name == nameType -> pure name
       | otherwise ->
-          throwError $
-            "lookupOrInsertName: Invariant violated, trying to insert a different name type for a name that's already known. Got: "
-              <> show nameType
-              <> " but expected: "
-              <> show (rnNameType name)
+          throwError $ LookupOrInsertNameUnexpectedType (rnNameType name) nameType
 
 -- | Insert an occurrence name into the current 'ScopeTable'.
 -- The new 'OccName' will overwrite (shadow?) any existing names.
@@ -366,7 +438,7 @@ lookupExistingFunction :: RnName -> Renamer FuncInfo
 lookupExistingFunction rnFnName = do
   funcInfoM <- use (scScopeTable % stFunction % at rnFnName)
   case funcInfoM of
-    Nothing -> throwError $ "lookupExistingFunction: Assumptions violated, function name wasn't found: " <> show rnFnName
+    Nothing -> throwError $ UnexpectedRnNameNotFound rnFnName
     Just funcInfo -> pure funcInfo
 
 -- | Execute a 'Renamer' action, but record which 'RnName's and 'FuncInfo's
@@ -419,10 +491,10 @@ renameRuleTopLevel rule = do
     (res, s) = runRenamerFor [rule]
   TL.putStrLn $ Pretty.pShow s
   case res of
-    Left err -> putStrLn err
+    Left err -> Text.putStrLn $ renderRenamerError err
     Right rnRules -> TL.putStrLn $ Pretty.pShow $ head rnRules
 
-runRenamerFor :: (Traversable f) => f Rule -> (Either String (f RnRule), Scope)
+runRenamerFor :: (Traversable f) => f Rule -> (Either RenamerError (f RnRule), Scope)
 runRenamerFor rule =
   let
     (resE, scope) = State.runState (Except.runExceptT (runRenamer $ renameRules rule)) emptyScope
@@ -450,8 +522,8 @@ scanRule rule@Rule.Hornlike{} = do
     scanGiveths rule.giveth
     traverse_ scanHornClause rule.clauses
   pure exports
-scanRule r@Rule.Regulative{} = throwError $ "scanRule: Unsupported rule: " <> show r
-scanRule r@Rule.Constitutive{} = throwError $ "scanRule: Unsupported rule: " <> show r
+scanRule r@Rule.Regulative{} = throwError $ UnsupportedRule "scanRule" r
+scanRule r@Rule.Constitutive{} = throwError $ UnsupportedRule "scanRule" r
 scanRule rule@Rule.TypeDecl{} = do
   traverse_ scanTypeSignature rule.super
   scanEnums rule.enums
@@ -460,14 +532,14 @@ scanRule rule@Rule.TypeDecl{} = do
   scanTypeDeclName rule.name
   typeScope <- use scScopeTable
   pure typeScope
-scanRule r@Rule.Scenario{} = throwError $ "scanRule: Unsupported rule: " <> show r
-scanRule r@Rule.DefNameAlias{} = throwError $ "scanRule: Unsupported rule: " <> show r
-scanRule r@Rule.DefTypically{} = throwError $ "scanRule: Unsupported rule: " <> show r
-scanRule r@Rule.RuleAlias{} = throwError $ "scanRule: Unsupported rule: " <> show r
-scanRule r@Rule.RuleGroup{} = throwError $ "scanRule: Unsupported rule: " <> show r
-scanRule r@Rule.RegFulfilled{} = throwError $ "scanRule: Unsupported rule: " <> show r
-scanRule r@Rule.RegBreach{} = throwError $ "scanRule: Unsupported rule: " <> show r
-scanRule r@Rule.NotARule{} = throwError $ "scanRule: Unsupported rule: " <> show r
+scanRule r@Rule.Scenario{} = throwError $ UnsupportedRule "scanRule" r
+scanRule r@Rule.DefNameAlias{} = throwError $ UnsupportedRule "scanRule" r
+scanRule r@Rule.DefTypically{} = throwError $ UnsupportedRule "scanRule" r
+scanRule r@Rule.RuleAlias{} = throwError $ UnsupportedRule "scanRule" r
+scanRule r@Rule.RuleGroup{} = throwError $ UnsupportedRule "scanRule" r
+scanRule r@Rule.RegFulfilled{} = throwError $ UnsupportedRule "scanRule" r
+scanRule r@Rule.RegBreach{} = throwError $ UnsupportedRule "scanRule" r
+scanRule r@Rule.NotARule{} = throwError $ UnsupportedRule "scanRule" r
 
 -- | Scan a 'LS.HornClause2' for declarations of variables and functions.
 scanHornClause :: LS.HornClause2 -> Renamer ()
@@ -482,7 +554,7 @@ scanHornClause hc = do
 -- which allows the *introduction* of variables.
 scanDecideHeadClause :: LS.RelationalPredicate -> Renamer ()
 scanDecideHeadClause = \case
-  LS.RPParamText pText -> throwError $ "Received 'RPParamText', we can't handle that yet. Got: " <> show pText
+  LS.RPParamText pText -> throwError $ UnsupportedRPParamText pText --  $ "Received 'RPParamText', we can't handle that yet. Got: " <> show pText
   LS.RPMT mt -> scanDecideMultiTerm mt
   LS.RPConstraint lhs _predicate _rhs -> do
     scanDecideMultiTerm lhs
@@ -535,7 +607,9 @@ scanDecideMultiTerm mt = do
       | Just (fnOccName, preArgs, postArgs) <- scanForFunctionDecl scopeTable fnDecl -> do
           rnF <- lookupOrInsertName fnOccName RnFunction
           insertFunction rnF (FuncInfo{_funcArity = (preArgs, postArgs)})
-    unknownPattern -> throwError $ "While scanning a multi term in a top-level DECIDE clause, we encountered an unsupported pattern: " <> show unknownPattern
+    unknownPattern -> throwError $ UnknownMultiTerms unknownPattern
+
+-- throwError $ "While scanning a multi term in a top-level DECIDE clause, we encountered an unsupported pattern: " <> show unknownPattern
 
 -- | Check whether this could be a function like structure.
 --
@@ -718,8 +792,8 @@ renameRule rule@Rule.Hornlike{} = do
         , defaults
         , symtab
         }
-renameRule r@Rule.Regulative{} = throwError $ "renameRule: Unsupported rule: " <> show r
-renameRule r@Rule.Constitutive{} = throwError $ "renameRule: Unsupported rule: " <> show r
+renameRule r@Rule.Regulative{} = throwError $ UnsupportedRule "renameRule" r
+renameRule r@Rule.Constitutive{} = throwError $ UnsupportedRule "renameRule" r
 renameRule rule@Rule.TypeDecl{} = do
   super <- traverse renameTypeSignature rule.super
   defaults <- assertEmptyList rule.defaults
@@ -744,14 +818,14 @@ renameRule rule@Rule.TypeDecl{} = do
         , defaults
         , symtab
         }
-renameRule r@Rule.Scenario{} = throwError $ "renameRule: Unsupported rule: " <> show r
-renameRule r@Rule.DefNameAlias{} = throwError $ "renameRule: Unsupported rule: " <> show r
-renameRule r@Rule.DefTypically{} = throwError $ "renameRule: Unsupported rule: " <> show r
-renameRule r@Rule.RuleAlias{} = throwError $ "renameRule: Unsupported rule: " <> show r
-renameRule r@Rule.RuleGroup{} = throwError $ "renameRule: Unsupported rule: " <> show r
-renameRule r@Rule.RegFulfilled{} = throwError $ "renameRule: Unsupported rule: " <> show r
-renameRule r@Rule.RegBreach{} = throwError $ "renameRule: Unsupported rule: " <> show r
-renameRule r@Rule.NotARule{} = throwError $ "renameRule: Unsupported rule: " <> show r
+renameRule r@Rule.Scenario{} = throwError $ UnsupportedRule "renameRule" r
+renameRule r@Rule.DefNameAlias{} = throwError $ UnsupportedRule "renameRule" r
+renameRule r@Rule.DefTypically{} = throwError $ UnsupportedRule "renameRule" r
+renameRule r@Rule.RuleAlias{} = throwError $ UnsupportedRule "renameRule" r
+renameRule r@Rule.RuleGroup{} = throwError $ UnsupportedRule "renameRule" r
+renameRule r@Rule.RegFulfilled{} = throwError $ UnsupportedRule "renameRule" r
+renameRule r@Rule.RegBreach{} = throwError $ UnsupportedRule "renameRule" r
+renameRule r@Rule.NotARule{} = throwError $ UnsupportedRule "renameRule" r
 
 renameLocalRules :: [Rule] -> Renamer [RnRule]
 renameLocalRules = renameRules
@@ -766,7 +840,7 @@ renameUpons ::
   Maybe LS.ParamText ->
   Renamer (Maybe RnParamText)
 renameUpons Nothing = pure Nothing
-renameUpons (Just xs) = throwError $ "Unsupported \"UPON\", got: " <> show xs
+renameUpons (Just xs) = throwError $ UnsupportedUpon xs
 
 renameGiveths ::
   Maybe LS.ParamText ->
@@ -842,7 +916,8 @@ renameHornClause hc = do
 
 renameRelationalPredicate :: LS.RelationalPredicate -> Renamer RnRelationalPredicate
 renameRelationalPredicate = \case
-  LS.RPParamText pText -> throwError $ "Received 'RPParamText', we can't handle that yet. Got: " <> show pText
+  LS.RPParamText pText ->
+    throwError $ UnsupportedRPParamText pText
   LS.RPMT mt -> RnRelationalTerm <$> renameMultiTerm mt
   LS.RPConstraint lhs relationalPredicate rhs -> do
     rnLhs <- renameMultiTerm lhs
@@ -910,35 +985,28 @@ renameMultiTerm multiTerms = do
       let
         (preNum, postNum) = funcInfo ^. funcArity
       (lhs, fnExpr, rhs) <- findFunctionApplication fnName rnMultiTerms
-      (leftNonArgs, leftArgs) <- processLhs preNum lhs
-      (rightNonArgs, rightArgs) <- processRhs postNum rhs
+      (leftNonArgs, leftArgs) <- processLhs fnName preNum lhs
+      (rightNonArgs, rightArgs) <- processRhs fnName postNum rhs
       pure $ reverse leftNonArgs <> [fnExpr] <> leftArgs <> rightArgs <> rightNonArgs
 
   findFunctionApplication fnName rnMultiTerms = do
     let
       (preArgs, postArgsWithName) = List.break (== (RnExprName fnName)) rnMultiTerms
     case postArgsWithName of
-      [] -> throwError "fixFixity: Invariant violated, function name reported, but none found."
+      [] -> throwError $ FixArityFunctionNotFound fnName rnMultiTerms
+      -- throwError "fixFixity: Invariant violated, function name reported, but none found."
       (fnExpr : postArgs) -> pure (preArgs, fnExpr, postArgs)
 
-  processLhs n lhs = do
+  processLhs name n lhs = do
     case safeSplitAt n (reverse lhs) of
       Nothing ->
-        throwError $
-          "Not enough elements in left hand side of function application. Required: "
-            <> show n
-            <> " but got: "
-            <> show (length lhs)
+        throwError $ ArityErrorLeft n name lhs
       Just (args, nonArgs) -> pure (reverse nonArgs, reverse args)
 
-  processRhs n rhs = do
+  processRhs name n rhs = do
     case safeSplitAt n rhs of
       Nothing ->
-        throwError $
-          "Not enough elements in left hand side of function application. Required: "
-            <> show n
-            <> " but got: "
-            <> show (length rhs)
+        throwError $ ArityErrorRight n name rhs
       Just (nonArgs, args) -> pure (nonArgs, args)
 
   initialMultiTermContext =
@@ -1038,19 +1106,19 @@ oTHERWISE = "OTHERWISE"
 assertSingletonMultiTerm :: (Show (f LS.MTExpr), Foldable f) => f LS.MTExpr -> Renamer LS.MTExpr
 assertSingletonMultiTerm xs = case Foldable.toList xs of
   [x] -> pure x
-  _ -> throwError $ "Expected singleton but got: " <> show xs
+  _ -> throwError $ UnexpectedNonSingletonList xs
 
 assertNoTypeSignature :: LS.TypedMulti -> Renamer (NonEmpty LS.MTExpr)
-assertNoTypeSignature tm@(_, Just _) = throwError $ "Expected no type signature but got: " <> show tm
+assertNoTypeSignature tm@(_, Just _) = throwError $ UnexpectedTypeSignature tm
 assertNoTypeSignature (mtt, Nothing) = do
   pure mtt
 
 -- | If we can't handle renaming certain list of things, we just hope that
 -- the parser doesn't give us a list with any elements.
 -- We throwError if the list is not @'null'@.
-assertEmptyList :: (Show a, MonadError String m) => [a] -> m [b]
+assertEmptyList :: (Show a, MonadError RenamerError m) => [a] -> m [b]
 assertEmptyList [] = pure []
-assertEmptyList xs = throwError $ "Expected an empty list, but got: " <> show xs
+assertEmptyList xs = throwError $ UnexpectedNonEmptyList xs
 
 -- ----------------------------------------------------------------------------
 -- Helper utils non specific to the renamer.
diff --git a/lib/haskell/natural4/test/LS/RenamerSpec.hs b/lib/haskell/natural4/test/LS/RenamerSpec.hs
index fd7da5794..3a27eb0ce 100644
--- a/lib/haskell/natural4/test/LS/RenamerSpec.hs
+++ b/lib/haskell/natural4/test/LS/RenamerSpec.hs
@@ -7,6 +7,7 @@
 module LS.RenamerSpec (spec) where
 
 import Data.String.Interpolate
+import Data.Text qualified as Text
 import Data.Text.Lazy qualified as TL
 import Data.Text.Lazy.IO qualified as TL
 import LS.Renamer qualified as Renamer
@@ -115,9 +116,9 @@ spec = do
         case runList ruleSource of
           Left err -> Left $ "Failed to parse program:\n" <> ruleSource <> "\n" <> err
           Right rules ->
-              case fst $ Renamer.runRenamerFor rules of
-                Left err -> Left $ "Failed to rename program: " <> err
-                Right rnRules -> Right rnRules
+            case fst $ Renamer.runRenamerFor rules of
+              Left err -> Left $ "Failed to rename program: " <> Text.unpack (Renamer.renderRenamerError err)
+              Right rnRules -> Right rnRules
 
 runList :: String -> Either String [Rule]
 runList = fmap (fmap transRule) . pListRule . myLexer
diff --git a/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs b/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
index 929909a12..2092190f9 100644
--- a/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
+++ b/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
@@ -8,6 +8,7 @@ module LS.XPile.SimalaSpec (spec) where
 import Control.Monad.Trans.Except (runExcept)
 import Data.String.Interpolate
 import Data.Text qualified as Text
+import Data.Text.IO qualified as Text
 import Data.Text.Lazy qualified as TL
 import Data.Text.Lazy.IO qualified as TL
 import LS.Renamer qualified as Renamer
@@ -231,35 +232,35 @@ transpilerTest outputName ruleString = it outputName $
   goldenGeneric outputName $
     case runList ruleString of
       Left err ->
-        unlines
+        Text.unlines
           [ "Failed to parse program:"
-          , ruleString
+          , Text.pack ruleString
           , "Err:"
-          , err
+          , Text.pack err
           ]
       Right rules -> do
         case Renamer.runRenamerFor rules of
           (Left err, scope) ->
-            unlines
+            Text.unlines
               [ "Renaming failed for program:"
-              , ruleString
+              , Text.pack ruleString
               , "Because:"
-              , err
+              , Renamer.renderRenamerError err
               , "Scope table:"
-              , pShowNoColorS scope
+              , Text.pack $ pShowNoColorS scope
               ]
           (Right rnRules, _) -> do
             case runExcept (Simala.runTranspiler $ Simala.transpile rnRules) of
-              Left err -> "Failed transpilation:\n" <> err
-              Right simalaDecls -> Text.unpack $ Text.unlines $ fmap Simala.render simalaDecls
+              Left err -> "Failed transpilation:\n" <> Text.pack err
+              Right simalaDecls -> Text.unlines $ fmap Simala.render simalaDecls
 
-goldenGeneric :: String -> String -> Golden TL.Text
+goldenGeneric :: String -> Text.Text -> Golden Text.Text
 goldenGeneric name output_ =
   Golden
-    { output = TL.pack output_
-    , encodePretty = TL.unpack
-    , writeToFile = TL.writeFile
-    , readFromFile = TL.readFile
+    { output = output_
+    , encodePretty = Text.unpack
+    , writeToFile = Text.writeFile
+    , readFromFile = Text.readFile
     , goldenFile = testPath <.> "expected"
     , actualFile = Just (testPath <.> "actual")
     , failFirstTime = False

From f638221f1d543950fd00e2b51e6ddccfc4e0e8df Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Tue, 13 Aug 2024 17:48:19 +0200
Subject: [PATCH 30/44] Add typed errors to simala transpilation phase

---
 lib/haskell/natural4/src/LS/Renamer.hs        |  21 +-
 .../natural4/src/LS/XPile/Simala/Transpile.hs | 205 +++++++++++++-----
 .../natural4/test/LS/XPile/SimalaSpec.hs      |   3 +-
 .../fail-id-func-multi-wrong-arity-1.expected |   2 +-
 .../fail-id-func-multi-wrong-arity-2.expected |   2 +-
 .../xpile/simala/rodents-and-vermin.expected  |   2 +-
 6 files changed, 162 insertions(+), 73 deletions(-)

diff --git a/lib/haskell/natural4/src/LS/Renamer.hs b/lib/haskell/natural4/src/LS/Renamer.hs
index cf54d1848..129ab706a 100644
--- a/lib/haskell/natural4/src/LS/Renamer.hs
+++ b/lib/haskell/natural4/src/LS/Renamer.hs
@@ -34,6 +34,7 @@ module LS.Renamer (
 
   -- * Renamer Errors
   RenamerError (..),
+  AssertionError(..),
   renderRenamerError,
 
   -- * Scope checking types
@@ -228,8 +229,10 @@ data RenamerError
   | UnexpectedRnNameNotFound RnName
   | InsertNameUnexpectedType RnNameType RnNameType
   | LookupOrInsertNameUnexpectedType RnNameType RnNameType
-  | -- Validation Errors
-    forall a. (Show a) => UnexpectedNonEmptyList [a]
+  | AssertErr AssertionError
+
+data AssertionError -- Validation Errors
+  = forall a. (Show a) => UnexpectedNonEmptyList [a]
   | forall a f. (Show (f a), Foldable f) => UnexpectedNonSingletonList (f a)
   | UnexpectedTypeSignature LS.TypedMulti
 
@@ -277,11 +280,11 @@ renderRenamerError = \case
       <> " but expected: "
       <> Text.pack (show expected)
   -- Validation Errrors
-  UnexpectedNonEmptyList xs ->
+  AssertErr (UnexpectedNonEmptyList xs) ->
     "Expected an empty list, but got: " <> Text.pack (show xs)
-  UnexpectedNonSingletonList xs ->
+  AssertErr (UnexpectedNonSingletonList xs) ->
     "Expected an singleton list, but got: " <> Text.pack (show xs)
-  UnexpectedTypeSignature tm ->
+  AssertErr (UnexpectedTypeSignature tm) ->
     "Expected no type signature, but got: " <> Text.pack (show tm)
 
 -- ----------------------------------------------------------------------------
@@ -1106,19 +1109,19 @@ oTHERWISE = "OTHERWISE"
 assertSingletonMultiTerm :: (Show (f LS.MTExpr), Foldable f) => f LS.MTExpr -> Renamer LS.MTExpr
 assertSingletonMultiTerm xs = case Foldable.toList xs of
   [x] -> pure x
-  _ -> throwError $ UnexpectedNonSingletonList xs
+  _ -> throwError $ AssertErr $ UnexpectedNonSingletonList xs
 
 assertNoTypeSignature :: LS.TypedMulti -> Renamer (NonEmpty LS.MTExpr)
-assertNoTypeSignature tm@(_, Just _) = throwError $ UnexpectedTypeSignature tm
+assertNoTypeSignature tm@(_, Just _) = throwError $ AssertErr $ UnexpectedTypeSignature tm
 assertNoTypeSignature (mtt, Nothing) = do
   pure mtt
 
 -- | If we can't handle renaming certain list of things, we just hope that
 -- the parser doesn't give us a list with any elements.
 -- We throwError if the list is not @'null'@.
-assertEmptyList :: (Show a, MonadError RenamerError m) => [a] -> m [b]
+assertEmptyList :: (Show a) => [a] -> Renamer [b]
 assertEmptyList [] = pure []
-assertEmptyList xs = throwError $ UnexpectedNonEmptyList xs
+assertEmptyList xs = throwError $ AssertErr $ UnexpectedNonEmptyList xs
 
 -- ----------------------------------------------------------------------------
 -- Helper utils non specific to the renamer.
diff --git a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
index a64260910..a6cea2b77 100644
--- a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
+++ b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
@@ -23,7 +23,7 @@ import Data.Tuple (Solo (..))
 import Optics
 import Text.Pretty.Simple qualified as Pretty
 
-import LS.Renamer
+import LS.Renamer hiding (AssertionError (..), RenamerError (..), assertEmptyList)
 import LS.Rule qualified as LS
 import LS.Types qualified as LS
 import TextuaL4.ParTextuaL qualified as Parser
@@ -99,13 +99,105 @@ data SimalaTerm
     TermExpr Simala.Expr
   deriving (Show)
 
+-- ----------------------------------------------------------------------------
+-- Typed Error
+-- ----------------------------------------------------------------------------
+
+data TranspilerError
+  = TermToDeclUnsupported SimalaTerm
+  | UnsupportedLocalTerm Text SimalaTerm
+  | UnsupportedMultiTerm RnMultiTerm
+  | UnsupportedEmptyMultiTerm
+  | ImpossibleLeftSide SimalaTerm
+  | UnsupportedLeftSide RnMultiTerm
+  | UnsupportedRightSide RnMultiTerm
+  | NotImplemented Text
+  | UnsupportedPredicate LS.RPRel
+  | FailedToCombineTerms SimalaTerm SimalaTerm
+  | AssertErr AssertionError
+
+data ExpectedSize
+  = SizeExact !Int
+  | SizeAtLeast !Int
+
+data AssertionError
+  = forall a. (Show a) => UnexpectedNonEmptyList [a]
+  | NotTermAttribute SimalaTerm
+  | NotSingletonList Text !Int
+  | NotTermExpr SimalaTerm
+  | NotMultiTerm Text RnRelationalPredicate
+  | NotRecord Simala.Expr
+  | NotSelectorChain SimalaTerm
+  | forall a. (Show a) => NotEquals a a
+  | UnexpectedEmptyList
+  | UnexpectedListSize ExpectedSize !Int
+
+throwAssertion :: AssertionError -> Transpiler a
+throwAssertion = throwError . AssertErr
+
+renderTranspilerError :: TranspilerError -> Text
+renderTranspilerError = \case
+  TermToDeclUnsupported term ->
+    "Cannot convert SimalaTerm to Decl: " <> tshow term
+  UnsupportedLocalTerm herald term ->
+    herald <> ": Unexpected local term: " <> tshow term
+  UnsupportedMultiTerm multiTerm ->
+    "Unsupported RnMultiTerms: " <> tshow multiTerm
+  UnsupportedEmptyMultiTerm ->
+    "Unexpected empty list of RnMultiTerms"
+  ImpossibleLeftSide term ->
+    "The following SimalaTerm cannot occur on the left hand side of an assignment: " <> tshow term
+  UnsupportedLeftSide multiTerm ->
+    "Unsupported on the left side of an assignment: " <> tshow multiTerm
+  UnsupportedRightSide multiTerm ->
+    "Unsupported on the right side of an assignment: " <> tshow multiTerm
+  NotImplemented herald ->
+    herald <> ": unsupported"
+  UnsupportedPredicate relPred ->
+    "Unsupported RelationalPredicate: " <> tshow relPred
+  FailedToCombineTerms term1 term2 ->
+    "Can't wrap terms in an if-then-else.\nFirst term: "
+      <> tshow term1
+      <> "\nSecond term: "
+      <> tshow term2
+  AssertErr assertionErr -> case assertionErr of
+    UnexpectedNonEmptyList list ->
+      "Expected empty list, but got: " <> tshow list
+    NotTermAttribute term ->
+      "Expected TermAttribute, but got: " <> tshow term
+    NotSingletonList herald size ->
+      herald <> ": Expected singleton list, but got: " <> tshow size
+    NotTermExpr term ->
+      "Expected TermAttribute, but got: " <> tshow term
+    NotMultiTerm herald rnPred ->
+      herald <> ": Expected MultiTerm, but got: " <> tshow rnPred
+    NotRecord expr ->
+      "Expected Record, but got: " <> tshow expr
+    NotSelectorChain term ->
+      "Expected TermAttribute with non-empty selectors, but got: " <> tshow term
+    NotEquals a b ->
+      "Not equal: " <> tshow a <> ", " <> tshow b
+    UnexpectedEmptyList ->
+      "Expected non-empty list"
+    UnexpectedListSize len n ->
+      "Expected list of "
+        <> ( case len of
+              SizeExact i -> "size " <> tshow i
+              SizeAtLeast i -> "at least size " <> tshow i
+           )
+        <> ", but got "
+        <> tshow n
+
+tshow :: (Show a) => a -> Text
+tshow = Text.pack . show
+
 -- ----------------------------------------------------------------------------
 -- Top Level transpilation functions and test helpers
 -- ----------------------------------------------------------------------------
 
-newtype Transpiler a = Transpiler {runTranspiler :: Except String a}
+newtype Transpiler a = Transpiler {runTranspiler :: Except TranspilerError a}
   deriving newtype (Functor, Applicative, Monad)
-  deriving newtype (MonadError String)
+  deriving newtype (MonadError TranspilerError)
 
 transpile :: [RnRule] -> Transpiler [Simala.Decl]
 transpile rules = do
@@ -117,8 +209,8 @@ toSimalaDecl (TermLetIn t name expr) = do
   pure $ Simala.NonRec t name expr
 toSimalaDecl (TermFunction t name params expr) = do
   pure $ Simala.NonRec t name $ mkFunctionDecl t params expr
-toSimalaDecl _term = do
-  throwError $ "toSimalaDecl: Cannot convert SimalaTerms to Decl: " <> show _term
+toSimalaDecl term = do
+  throwError $ TermToDeclUnsupported term
 
 -- ----------------------------------------------------------------------------
 -- Main translation helpers
@@ -220,8 +312,8 @@ groupClauses simalaTerms = do
 addLocalDefinitions :: SimalaTerm -> [SimalaTerm] -> Transpiler SimalaTerm
 addLocalDefinitions top [] = pure top
 addLocalDefinitions top (x : xs) = case top of
-  TermExpr{} -> throwError $ "addLocalDefinitions: Unexpected SimalaTerm: " <> show top
-  TermApp{} -> throwError $ "addLocalDefinitions: Unexpected SimalaTerm: " <> show top
+  TermExpr{} -> throwError $ UnsupportedLocalTerm "addLocalDefinitions" top
+  TermApp{} -> throwError $ UnsupportedLocalTerm "addLocalDefinitions" top
   TermLetIn t name expr -> do
     exprWithLocals <- linearLetIns expr (x :| xs)
     pure $ TermLetIn t name exprWithLocals
@@ -238,10 +330,10 @@ addLocalDefinitions top (x : xs) = case top of
       [] -> pure finalExpr
       (a : as) -> linearLetIns finalExpr (a :| as)
     case NE.head terms of
-      TermApp{} -> throwError $ "linearLetIns: Unexpected SimalaTerm: " <> show (NE.head terms)
+      TermApp{} -> throwError $ UnsupportedLocalTerm "linearLetIns" (NE.head terms)
+      TermExpr{} -> throwError $ UnsupportedLocalTerm "linearLetIns" (NE.head terms)
       TermLetIn t name expr -> do
         pure $ mkLetIn t name expr inExpr
-      TermExpr{} -> throwError $ "linearLetIns: Unexpected SimalaTerm: " <> show (NE.head terms)
       TermAttribute name [] expr -> do
         pure $ mkLetIn Simala.Transparent name expr inExpr
       TermAttribute name (a : as) expr -> do
@@ -343,8 +435,8 @@ relationalPredicateToSimala = \case
       | Just (var, selectors) <- isAssignment mtHead args -> do
           rhsExpr <- rhsMultiTermToSimala rhs
           mkAssignmentTerm (toSimalaName var) (fmap toSimalaName selectors) rhsExpr
-      | otherwise -> throwError $ "relationalPredicateToSimala: Unsupported " <> show lhs
-    [] -> throwError "empty lhs"
+      | otherwise -> throwError $ UnsupportedMultiTerm lhs
+    [] -> throwError UnsupportedEmptyMultiTerm
   RnConstraint lhs predicate rhs -> do
     lhsSimalaExpr' <- lhsMultiTermToSimala lhs
     lhsSimalaExpr <- assertTermExpr lhsSimalaExpr'
@@ -359,14 +451,14 @@ relationalPredicateToSimala = \case
         fnExpr <- assertSingletonList "RnNary.TermApp" rhsExprs
         rhsExpr <- assertTermExpr fnExpr
         mkFunctionTerm fnName fnParams (TermExpr rhsExpr)
-      TermLetIn{} -> throwError "Not implemented yet"
+      TermLetIn{} -> throwError $ ImpossibleLeftSide lhsSimalaTerm
       TermAttribute name selectors Simala.Undefined -> do
         someRhs <- assertSingletonList "RnNary.TermAttribute" rhsExprs
         rhsExpr <- assertTermExpr someRhs
         pure $ TermAttribute name selectors rhsExpr
-      TermAttribute _name _selectors _expr -> throwError "Not implemented yet"
-      TermFunction{} -> throwError "Not implemented yet"
-      TermExpr expr -> throwError $ "A saturated expression can't be left hand side: " <> show expr
+      TermAttribute{} -> throwError $ ImpossibleLeftSide lhsSimalaTerm
+      TermFunction{} -> throwError $ NotImplemented "RpNary RPis TermFunction"
+      TermExpr{} -> throwError $ ImpossibleLeftSide lhsSimalaTerm
   -- TODO: this is wrong, what about Var and Project?
   RnNary predicate mt ->
     predicateToSimala predicate mt
@@ -384,15 +476,15 @@ predicateToSimala rp params' = do
 
 predRelToBuiltIn :: LS.RPRel -> [Simala.Expr] -> Transpiler SimalaTerm
 predRelToBuiltIn rp exprs = case rp of
-  LS.RPis -> throwError $ "Unsupported relational predicate: " <> show rp
-  LS.RPhas -> throwError $ "Unsupported relational predicate: " <> show rp
+  LS.RPis -> throwError $ UnsupportedPredicate rp
+  LS.RPhas -> throwError $ UnsupportedPredicate rp
   LS.RPeq -> fixedArity Simala.Eq 2 exprs
   LS.RPlt -> fixedArity Simala.Lt 2 exprs
   LS.RPlte -> fixedArity Simala.Le 2 exprs
   LS.RPgt -> fixedArity Simala.Gt 2 exprs
   LS.RPgte -> fixedArity Simala.Ge 2 exprs
-  LS.RPelem -> throwError $ "Unsupported relational predicate: " <> show rp
-  LS.RPnotElem -> throwError $ "Unsupported relational predicate: " <> show rp
+  LS.RPelem -> throwError $ UnsupportedPredicate rp
+  LS.RPnotElem -> throwError $ UnsupportedPredicate rp
   LS.RPnot -> fixedArity Simala.Not 1 exprs
   LS.RPand -> flexibleArity Simala.And exprs
   LS.RPor -> flexibleArity Simala.Or exprs
@@ -401,11 +493,11 @@ predRelToBuiltIn rp exprs = case rp of
   LS.RPminus -> fixedArity Simala.Minus 2 exprs
   LS.RPdivide -> fixedArity Simala.Divide 2 exprs
   LS.RPmodulo -> fixedArity Simala.Modulo 2 exprs
-  LS.RPsubjectTo -> throwError $ "Unsupported relational predicate: " <> show rp
+  LS.RPsubjectTo -> throwError $ UnsupportedPredicate rp
   LS.RPmin -> atLeastArity Simala.Maximum 1 exprs
   LS.RPmax -> atLeastArity Simala.Minimum 1 exprs
-  LS.RPmap -> throwError $ "Unsupported relational predicate: " <> show rp
-  LS.RPTC _temporal -> throwError $ "Unsupported relational predicate: " <> show rp
+  LS.RPmap -> throwError $ UnsupportedPredicate rp
+  LS.RPTC _temporal -> throwError $ UnsupportedPredicate rp
 
 flexibleArity :: Simala.Builtin -> [Simala.Expr] -> Transpiler SimalaTerm
 flexibleArity b params = do
@@ -428,14 +520,14 @@ lhsMultiTermToSimala (mtHead : rest)
       mkFunctionHead (toSimalaName fnName) (fmap toSimalaName fnParams)
   | Just (varName, selectors) <- isProjection mtHead rest =
       mkRecordAssignmentTerm (toSimalaName varName) (fmap toSimalaName selectors)
-lhsMultiTermToSimala xs = throwError $ "lhsMultiTermToSimala: unsupported pattern: " <> show xs
+lhsMultiTermToSimala exprs = throwError $ UnsupportedLeftSide exprs
 
 rhsMultiTermToSimala :: RnMultiTerm -> Transpiler Simala.Expr
 rhsMultiTermToSimala [rnExpr] = pure $ exprToSimala rnExpr
 rhsMultiTermToSimala (mtHead : rest)
   | Just _fnName <- isFunction mtHead = pure $ Simala.App (exprToSimala mtHead) $ fmap exprToSimala rest
   | Just (varName, selectors) <- isProjection mtHead rest = pure $ applySelectors (toSimalaName varName) (fmap toSimalaName selectors)
-rhsMultiTermToSimala exprs = throwError $ "Unhandled rhs: " <> show exprs
+rhsMultiTermToSimala exprs = throwError $ UnsupportedRightSide exprs
 
 boolStructToSimala :: RnBoolStructR -> Transpiler Simala.Expr
 boolStructToSimala = \case
@@ -543,16 +635,12 @@ rnNameTypePrefix = \case
 
 assertIsTermAttribute :: SimalaTerm -> Transpiler (Simala.Name, [Simala.Name], Simala.Expr)
 assertIsTermAttribute (TermAttribute name selectors expr) = pure (name, selectors, expr)
-assertIsTermAttribute term = throwError $ "Expected TermAttribute but got: " <> show term
+assertIsTermAttribute term = throwAssertion $ NotTermAttribute term
 
-assertSingletonList :: String -> [a] -> Transpiler a
+assertSingletonList :: Text -> [a] -> Transpiler a
 assertSingletonList _errMsg [a] = pure a
 assertSingletonList errMsg as =
-  throwError $
-    errMsg
-      <> "\nExpected singleton list but got: "
-      <> show (length as)
-      <> " elements"
+  throwAssertion $ NotSingletonList errMsg (length as)
 
 assertLengthAtLeast :: Int -> [a] -> Transpiler [a]
 assertLengthAtLeast l as =
@@ -561,11 +649,7 @@ assertLengthAtLeast l as =
   in
     if len < l
       then
-        throwError $
-          "Unexpected list size, expected at least: "
-            <> show l
-            <> " but got: "
-            <> show (length as)
+        throwAssertion $ UnexpectedListSize (SizeAtLeast l) len
       else pure as
 
 assertLength :: Int -> [a] -> Transpiler [a]
@@ -575,38 +659,46 @@ assertLength l as =
   in
     if len /= l
       then
-        throwError $
-          "Expected list size, expected: "
-            <> show l
-            <> " but got: "
-            <> show (length as)
+        throwAssertion $ UnexpectedListSize (SizeExact l) len
       else pure as
 
 assertNonEmpty :: [a] -> Transpiler (NonEmpty a)
-assertNonEmpty [] = throwError "Expected non-empty list"
+assertNonEmpty [] = throwAssertion UnexpectedEmptyList
 assertNonEmpty (x : xs) = pure $ x :| xs
 
-assertPredicateIsMultiTerm :: String -> RnRelationalPredicate -> Transpiler RnMultiTerm
+assertPredicateIsMultiTerm :: Text -> RnRelationalPredicate -> Transpiler RnMultiTerm
 assertPredicateIsMultiTerm _errMsg (RnRelationalTerm mt) = pure mt
-assertPredicateIsMultiTerm errMsg predicate = throwError $ errMsg <> "\nExpected RnRelationalTerm but got: " <> show predicate
+assertPredicateIsMultiTerm errMsg predicate =
+  throwAssertion $ NotMultiTerm errMsg predicate
 
 assertTermExpr :: SimalaTerm -> Transpiler Simala.Expr
 assertTermExpr (TermExpr expr) = pure expr
-assertTermExpr term = throwError $ "Expected TermExpr but got: " <> show term
+assertTermExpr term =
+  throwAssertion $ NotTermExpr term
 
 assertEquals :: (Eq a, Show a) => a -> a -> Transpiler ()
 assertEquals a b
   | a == b = pure ()
-  | otherwise = throwError $ "Provided args are not equal: " <> show a <> " /= " <> show b
+  | otherwise =
+      throwAssertion $ NotEquals a b
 
 assertIsRecord :: Simala.Expr -> Transpiler (Simala.Row Simala.Expr)
 assertIsRecord (Simala.Record row) = pure row
-assertIsRecord simalaExpr = throwError $ "Unexpected simala expression, expected Record but got: " <> show simalaExpr
+assertIsRecord simalaExpr = throwAssertion $ NotRecord simalaExpr
 
 assertAttributeHasSelectors :: SimalaTerm -> Transpiler (NonEmpty Simala.Name, Simala.Expr)
 assertAttributeHasSelectors (TermAttribute _ (x : xs) expr) = pure (x :| xs, expr)
-assertAttributeHasSelectors expr@(TermAttribute _ [] _) = throwError $ "Unexpected term, expected non-empty TermAttribute but got: " <> show expr
-assertAttributeHasSelectors expr = throwError $ "Unexpected term, expected non-empty TermAttribute but got: " <> show expr
+assertAttributeHasSelectors expr@(TermAttribute _ [] _) =
+  throwAssertion $ NotSelectorChain expr
+assertAttributeHasSelectors expr =
+  throwAssertion $ NotTermAttribute expr
+
+-- | If we can't handle transpiling certain list of things, we just hope that
+-- the parser doesn't give us a list with any elements.
+-- We throwError if the list is not @'null'@.
+assertEmptyList :: (Show a) => [a] -> Transpiler [b]
+assertEmptyList [] = pure []
+assertEmptyList xs = throwError $ AssertErr $ UnexpectedNonEmptyList xs
 
 -- ----------------------------------------------------------------------------
 -- Construction helpers for simala terms
@@ -685,11 +777,7 @@ mkIfThenElseTerm b (TermExpr expr1) (TermExpr expr2) = do
     ifThenElse = Simala.mkIfThenElse b expr1 expr2
   pure $ TermExpr ifThenElse
 mkIfThenElseTerm _b term1 term2 =
-  throwError $
-    "Can't wrap terms in an if-then-else.\nFirst term: "
-      <> show term1
-      <> "\nSecond term: "
-      <> show term2
+  throwError $ FailedToCombineTerms term1 term2
 
 -- ----------------------------------------------------------------------------
 -- Construction helpers for simala expressions
@@ -736,7 +824,6 @@ buildRecordUpdate names expr = go $ NE.toList names
 -- @
 --   { x = { y = 5, z = { a = 0, b = 1 } }, f = 2 }
 -- @
---
 mergeRecordUpdates :: [Simala.Row Simala.Expr] -> Transpiler Simala.Expr
 mergeRecordUpdates rows = do
   let
@@ -772,11 +859,11 @@ debugTranspileRule ruleSrc = do
     (res, s) = runRenamerFor $ MkSolo rule
   TL.putStrLn $ Pretty.pShow s
   case res of
-    Left err -> putStrLn err
+    Left err -> Text.putStrLn $ renderRenamerError err
     Right (MkSolo rnRule) -> do
       TL.putStrLn $ Pretty.pShow rnRule
       case runExcept $ runTranspiler $ transpile [rnRule] of
-        Left err -> putStrLn err
+        Left err -> Text.putStrLn $ renderTranspilerError err
         Right decls -> flip Foldable.traverse_ decls $ \decl -> do
           Text.putStrLn $ "Decl: " <> Simala.render decl
 
@@ -785,10 +872,10 @@ transpileRulePure ruleSrc =
   case run ruleSrc of
     Left err -> Text.pack err
     Right rule -> case fst $ runRenamerFor (MkSolo rule) of
-      Left err -> Text.pack err
+      Left err -> renderRenamerError err
       Right (MkSolo rnRule) -> do
         case runExcept $ runTranspiler $ transpile [rnRule] of
-          Left err -> Text.pack err
+          Left err -> renderTranspilerError err
           Right expr ->
             Text.unlines $ fmap Simala.render expr
 
diff --git a/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs b/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
index 2092190f9..a273c14a4 100644
--- a/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
+++ b/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
@@ -10,7 +10,6 @@ import Data.String.Interpolate
 import Data.Text qualified as Text
 import Data.Text.IO qualified as Text
 import Data.Text.Lazy qualified as TL
-import Data.Text.Lazy.IO qualified as TL
 import LS.Renamer qualified as Renamer
 import LS.Rule
 import LS.XPile.Logging (pShowNoColorS)
@@ -251,7 +250,7 @@ transpilerTest outputName ruleString = it outputName $
               ]
           (Right rnRules, _) -> do
             case runExcept (Simala.runTranspiler $ Simala.transpile rnRules) of
-              Left err -> "Failed transpilation:\n" <> Text.pack err
+              Left err -> "Failed transpilation:\n" <> Simala.renderTranspilerError err
               Right simalaDecls -> Text.unlines $ fmap Simala.render simalaDecls
 
 goldenGeneric :: String -> Text.Text -> Golden Text.Text
diff --git a/lib/haskell/natural4/test/testdata/golden/renamer/fail-id-func-multi-wrong-arity-1.expected b/lib/haskell/natural4/test/testdata/golden/renamer/fail-id-func-multi-wrong-arity-1.expected
index c6d594003..b3986e713 100644
--- a/lib/haskell/natural4/test/testdata/golden/renamer/fail-id-func-multi-wrong-arity-1.expected
+++ b/lib/haskell/natural4/test/testdata/golden/renamer/fail-id-func-multi-wrong-arity-1.expected
@@ -1 +1 @@
-Left "Failed to rename program: Not enough elements in left hand side of function application. Required: 1 but got: 0"
\ No newline at end of file
+Left "Failed to rename program: Not enough elements in left hand side of function RnName {rnOccName = MTT "g" :| [], rnUniqueId = 3, rnNameType = RnFunction}. Required: 1 but got: 0 ([])"
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/renamer/fail-id-func-multi-wrong-arity-2.expected b/lib/haskell/natural4/test/testdata/golden/renamer/fail-id-func-multi-wrong-arity-2.expected
index c6d594003..b3986e713 100644
--- a/lib/haskell/natural4/test/testdata/golden/renamer/fail-id-func-multi-wrong-arity-2.expected
+++ b/lib/haskell/natural4/test/testdata/golden/renamer/fail-id-func-multi-wrong-arity-2.expected
@@ -1 +1 @@
-Left "Failed to rename program: Not enough elements in left hand side of function application. Required: 1 but got: 0"
\ No newline at end of file
+Left "Failed to rename program: Not enough elements in left hand side of function RnName {rnOccName = MTT "g" :| [], rnUniqueId = 3, rnNameType = RnFunction}. Required: 1 but got: 0 ([])"
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/rodents-and-vermin.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/rodents-and-vermin.expected
index e6f7a693d..b96c1bc0e 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/rodents-and-vermin.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/rodents-and-vermin.expected
@@ -1,2 +1,2 @@
 Failed transpilation:
-Unsupported relational predicate: RPis
\ No newline at end of file
+Unsupported RelationalPredicate: RPis
\ No newline at end of file

From d5025c0e5ad7d971ba4388facde6c728958aca63 Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Wed, 14 Aug 2024 11:24:09 +0200
Subject: [PATCH 31/44] WIP, add simala to main cli

---
 lib/haskell/natural4/app/Main.hs                      | 8 ++++++++
 lib/haskell/natural4/src/LS/Lib.hs                    | 5 +++++
 lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs | 3 ++-
 3 files changed, 15 insertions(+), 1 deletion(-)

diff --git a/lib/haskell/natural4/app/Main.hs b/lib/haskell/natural4/app/Main.hs
index ea1f506d7..226020f52 100644
--- a/lib/haskell/natural4/app/Main.hs
+++ b/lib/haskell/natural4/app/Main.hs
@@ -550,6 +550,10 @@ transpilersMap =
     , "an anyall SVG of the decision trees"
     , [aasvgTranspiler]
     )
+  , ( SFL4.simalaMode
+    , "Simala expressions for hornlike"
+    , [simalaTranspiler]
+    )
   ]
 
 toNative :: [SFL4.Rule] -> SFL4.Interpreted -> String
@@ -1109,6 +1113,10 @@ aasvgTranspiler =
           Nothing ->
             pure () -- no on-screen output
 
+simalaTranspiler :: Transpiler
+simalaTranspiler = undefined
+  -- simpleTranspiler "simala" "simala" (withErrors (onlyRules id))
+
 rulesTranspiler :: Transpiler
 rulesTranspiler =
   screenTranspiler "rules" (withoutErrors (onlyRules id))
diff --git a/lib/haskell/natural4/src/LS/Lib.hs b/lib/haskell/natural4/src/LS/Lib.hs
index 3e476c701..39ea6ffa9 100644
--- a/lib/haskell/natural4/src/LS/Lib.hs
+++ b/lib/haskell/natural4/src/LS/Lib.hs
@@ -65,6 +65,7 @@ module LS.Lib
     vueMode,
     pursMode,
     uppaalMode,
+    simalaMode,
     defaultModes,
     knownModes
   )
@@ -419,6 +420,7 @@ defaultModes =
   , mathlangmwMode
   , genmathlangMode
   , introMode
+  , simalaMode
   ]
 
 -- | All known modes, including ones that are off by default.
@@ -547,6 +549,9 @@ genmathlangMode = MkModeName "genmathlang"
 introMode :: ModeName
 introMode = MkModeName "intro"
 
+simalaMode :: ModeName
+simalaMode = MkModeName "simala"
+
 getConfig :: Options -> IO RunConfig
 getConfig o = do
   mpd <- lookupEnv "MP_DEBUG"
diff --git a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
index a6cea2b77..14c4579ce 100644
--- a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
+++ b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
@@ -289,6 +289,7 @@ groupClauses simalaTerms = do
   compareClauseHeads (TermLetIn _ name1 _) (TermLetIn _ name2 _) = name1 == name2
   compareClauseHeads (TermFunction _ fnName1 _ _) (TermFunction _ fnName2 _ _) = fnName1 == fnName2
   compareClauseHeads (TermAttribute name1 _ _) (TermAttribute name2 _ _) = name1 == name2
+  compareClauseHeads (TermExpr _) (TermExpr _) = True
   compareClauseHeads _ _ = False
 
 -- | Takes the translation of local variables in where clauses and turns
@@ -330,8 +331,8 @@ addLocalDefinitions top (x : xs) = case top of
       [] -> pure finalExpr
       (a : as) -> linearLetIns finalExpr (a :| as)
     case NE.head terms of
-      TermApp{} -> throwError $ UnsupportedLocalTerm "linearLetIns" (NE.head terms)
       TermExpr{} -> throwError $ UnsupportedLocalTerm "linearLetIns" (NE.head terms)
+      TermApp{} -> throwError $ UnsupportedLocalTerm "linearLetIns" (NE.head terms)
       TermLetIn t name expr -> do
         pure $ mkLetIn t name expr inExpr
       TermAttribute name [] expr -> do

From d6b0b540b11134c3783f7e7d4dc90e6aaf56f839 Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Wed, 14 Aug 2024 13:55:23 +0200
Subject: [PATCH 32/44] Add Simala transpiler backend to main-cli

Adds Renamer results to `Interpreted` record.
---
 lib/haskell/cabal.project                     |  2 +-
 lib/haskell/natural4/app/Main.hs              | 19 ++++-
 lib/haskell/natural4/src/LS/Interpreter.hs    |  6 ++
 lib/haskell/natural4/src/LS/Renamer.hs        | 69 ++++++++++++++-----
 lib/haskell/natural4/src/LS/Rule.hs           |  1 -
 .../natural4/src/LS/XPile/Simala/Transpile.hs | 22 +++---
 lib/haskell/natural4/test/LS/RenamerSpec.hs   |  7 +-
 .../natural4/test/LS/XPile/SimalaSpec.hs      |  8 +--
 lib/haskell/natural4/test/og.csv              |  8 +--
 lib/haskell/stack.yaml                        |  2 +-
 lib/haskell/stack.yaml.lock                   | 10 +--
 11 files changed, 105 insertions(+), 49 deletions(-)

diff --git a/lib/haskell/cabal.project b/lib/haskell/cabal.project
index 1bfcf3201..190743fb9 100644
--- a/lib/haskell/cabal.project
+++ b/lib/haskell/cabal.project
@@ -30,7 +30,7 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/smucclaw/simala
-  tag: ca666a3b7155f306a9240a787910a2738b464f60
+  tag: 1cc4400e105cd8d6afa89cf742476d8303074d5f
 
 allow-newer:
   compact:*,
diff --git a/lib/haskell/natural4/app/Main.hs b/lib/haskell/natural4/app/Main.hs
index 226020f52..5e5d19e32 100644
--- a/lib/haskell/natural4/app/Main.hs
+++ b/lib/haskell/natural4/app/Main.hs
@@ -83,6 +83,7 @@ import LS.XPile.Petri (toPetri)
 import LS.XPile.Prolog (rulesToProlog, rulesToSCasp)
 import LS.XPile.Purescript (translate2PS)
 import LS.XPile.SVG qualified as AAS
+import LS.XPile.Simala.Transpile qualified as Simala
 import LS.XPile.Typescript (asTypescript)
 import LS.XPile.Uppaal qualified as Uppaal
 import LS.XPile.VueJSON
@@ -123,6 +124,7 @@ import System.IO.Unsafe (unsafeInterleaveIO)
 import Text.Pretty.Simple (pPrint, pShowNoColor)
 import Text.Regex.PCRE.Heavy qualified as PCRE
 import Text.XML.HXT.Core qualified as HXT
+import qualified LS.Renamer as Renamer
 
 --
 -- Command-line options parsing
@@ -551,7 +553,7 @@ transpilersMap =
     , [aasvgTranspiler]
     )
   , ( SFL4.simalaMode
-    , "Simala expressions for hornlike"
+    , "Transpile hornlike rules to the purely functional Simala language"
     , [simalaTranspiler]
     )
   ]
@@ -656,6 +658,13 @@ withNLGData k ds =
     Nothing  -> pure (Skipped "skipping transpiler due to lacking NLG environment")
     Just env -> k env ds
 
+withRnRules :: ([Renamer.RnRule] -> (TranspilationResult a)) -> DriverState -> (TranspilationResult a)
+withRnRules k ds = case ds.interpreted.renamedRules of
+  Renamer.RenamerFail errMsg _scope -> Skipped $ "Failed to rename rules: " <> errorToString errMsg
+  Renamer.RenamerSuccess rnRules _scope -> k rnRules
+  where
+    errorToString = Text.unpack . Renamer.renderRenamerError
+
 simpleTranspiler ::
      FilePath
   -> String
@@ -1114,8 +1123,12 @@ aasvgTranspiler =
             pure () -- no on-screen output
 
 simalaTranspiler :: Transpiler
-simalaTranspiler = undefined
-  -- simpleTranspiler "simala" "simala" (withErrors (onlyRules id))
+simalaTranspiler =
+  simpleTranspiler "simala" "simala" (withRnRules runSimalaTranspiler)
+  where
+    runSimalaTranspiler rnRules = case Simala.runSimalaTranspiler rnRules of
+      Left err -> mkResultWithErrors ("", lines $ Text.unpack $ Simala.renderTranspilerError err)
+      Right decls -> mkResultWithoutErrors (Text.unpack $ Simala.render decls)
 
 rulesTranspiler :: Transpiler
 rulesTranspiler =
diff --git a/lib/haskell/natural4/src/LS/Interpreter.hs b/lib/haskell/natural4/src/LS/Interpreter.hs
index 22f4f6d94..84a1d88e4 100644
--- a/lib/haskell/natural4/src/LS/Interpreter.hs
+++ b/lib/haskell/natural4/src/LS/Interpreter.hs
@@ -216,6 +216,7 @@ import LS.XPile.Logging
   )
 import Text.Pretty.Simple (pShowNoColor)
 import Text.Regex.PCRE.Heavy qualified as PCRE
+import qualified LS.Renamer as Renamer
 
 
 -- | This is generated by the Interpreter and handed around to different transpilers.
@@ -243,6 +244,8 @@ data Interpreted = L4I {
   -- eliminated. [TODO].
   , origrules  :: [Rule]
 
+  , renamedRules :: Renamer.RenamerResult [Renamer.RnRule]
+
   -- | valuepredicates contain the bulk of the top-level decision logic, and can be easily expressed as instance or class methosd.
   , valuePreds :: [ValuePredicate]
 
@@ -258,6 +261,7 @@ defaultL4I = L4I
   { classtable = CT Map.empty
   , scopetable = Map.empty
   , origrules = mempty
+  , renamedRules = Renamer.RenamerSuccess mempty Renamer.emptyScope
   , valuePreds = mempty
   , ruleGraph = Gr.empty
   , ruleGraphErr = mempty
@@ -289,10 +293,12 @@ l4interpret iopts rs =
       st = symbolTable    iopts rs
       (vp, _vpErr) = xpLog $ attrsAsMethods rs
       (rDGout, rDGerr) = xpLog $ ruleDecisionGraph rs
+      rnRules = Renamer.runRenamerFor rs
   in
     L4I { classtable = ct
         , scopetable = st
         , origrules  = rs
+        , renamedRules = rnRules
         , valuePreds = fromRight [] vp
         , ruleGraph  = rDGout
         , ruleGraphErr = rDGerr
diff --git a/lib/haskell/natural4/src/LS/Renamer.hs b/lib/haskell/natural4/src/LS/Renamer.hs
index 129ab706a..57961c6ed 100644
--- a/lib/haskell/natural4/src/LS/Renamer.hs
+++ b/lib/haskell/natural4/src/LS/Renamer.hs
@@ -29,6 +29,9 @@ module LS.Renamer (
   mkSimpleOccName,
 
   -- * Renamer Monad and runners
+  RenamerResult(..),
+  rnResultScope,
+
   Renamer (..),
   runRenamerFor,
 
@@ -39,6 +42,7 @@ module LS.Renamer (
 
   -- * Scope checking types
   Scope (..),
+  emptyScope,
   scScopeTable,
   scUniqueSupply,
   newUnique,
@@ -94,6 +98,7 @@ import Data.Text.Lazy.IO qualified as TL
 import GHC.Generics (Generic)
 import Optics hiding (has)
 import Text.Pretty.Simple qualified as Pretty
+import Data.Tuple (Solo(MkSolo))
 
 -- ----------------------------------------------------------------------------
 -- Types specific to the renamer phase
@@ -230,11 +235,21 @@ data RenamerError
   | InsertNameUnexpectedType RnNameType RnNameType
   | LookupOrInsertNameUnexpectedType RnNameType RnNameType
   | AssertErr AssertionError
+  deriving (Show, Eq, Ord)
 
 data AssertionError -- Validation Errors
-  = forall a. (Show a) => UnexpectedNonEmptyList [a]
-  | forall a f. (Show (f a), Foldable f) => UnexpectedNonSingletonList (f a)
+  = UnexpectedNonEmptyList Text.Text
+  -- ^ List is expected to be empty, but it wasn't!
+  -- The 'Text' parameter is a textual representation of the list that not
+  -- empty! We could use existentials (and we used to), but that makes deriving
+  -- more difficult, so I opted to the simpler solution for now.
+  | UnexpectedNonSingletonList Text.Text
+  -- ^ List is expected to be singleton list, but it wasn't!
+  -- The 'Text' parameter is a textual representation of the list that not
+  -- empty! We could use existentials (and we used to), but that makes deriving
+  -- more difficult, so I opted to the simpler solution for now.
   | UnexpectedTypeSignature LS.TypedMulti
+  deriving (Show, Eq, Ord)
 
 renderRenamerError :: RenamerError -> Text.Text
 renderRenamerError = \case
@@ -279,12 +294,16 @@ renderRenamerError = \case
       <> Text.pack (show actual)
       <> " but expected: "
       <> Text.pack (show expected)
+  AssertErr err -> renderAssertionError err
+
+renderAssertionError :: AssertionError -> Text.Text
+renderAssertionError = \case
   -- Validation Errrors
-  AssertErr (UnexpectedNonEmptyList xs) ->
-    "Expected an empty list, but got: " <> Text.pack (show xs)
-  AssertErr (UnexpectedNonSingletonList xs) ->
-    "Expected an singleton list, but got: " <> Text.pack (show xs)
-  AssertErr (UnexpectedTypeSignature tm) ->
+  UnexpectedNonEmptyList xs ->
+    "Expected an empty list, but got: " <> xs
+  UnexpectedNonSingletonList xs ->
+    "Expected an singleton list, but got: " <> xs
+  UnexpectedTypeSignature tm ->
     "Expected no type signature, but got: " <> Text.pack (show tm)
 
 -- ----------------------------------------------------------------------------
@@ -295,6 +314,16 @@ newtype Renamer a = Renamer {runRenamer :: ExceptT RenamerError (State Scope) a}
   deriving newtype (Functor, Applicative, Monad)
   deriving newtype (MonadState Scope, MonadError RenamerError)
 
+data RenamerResult a
+  = RenamerFail RenamerError Scope
+  | RenamerSuccess a Scope
+  deriving (Show, Eq, Ord)
+  deriving (Functor, Traversable, Foldable)
+
+rnResultScope :: RenamerResult a -> Scope
+rnResultScope (RenamerFail _ s) = s
+rnResultScope (RenamerSuccess _ s) = s
+
 type Unique = Int
 
 -- | An unresolved name as it occurs in the original source.
@@ -491,18 +520,20 @@ renameRuleTopLevel :: Rule -> IO ()
 renameRuleTopLevel rule = do
   TL.putStrLn $ Pretty.pShow rule
   let
-    (res, s) = runRenamerFor [rule]
-  TL.putStrLn $ Pretty.pShow s
-  case res of
-    Left err -> Text.putStrLn $ renderRenamerError err
-    Right rnRules -> TL.putStrLn $ Pretty.pShow $ head rnRules
-
-runRenamerFor :: (Traversable f) => f Rule -> (Either RenamerError (f RnRule), Scope)
-runRenamerFor rule =
+    renamerResult = runRenamerFor (MkSolo rule)
+  TL.putStrLn $ Pretty.pShow $ rnResultScope renamerResult
+  case renamerResult of
+    RenamerFail err _ -> Text.putStrLn $ renderRenamerError err
+    RenamerSuccess (MkSolo rnRules) _ -> TL.putStrLn $ Pretty.pShow rnRules
+
+runRenamerFor :: (Traversable f) => f Rule -> RenamerResult (f RnRule)
+runRenamerFor rules =
   let
-    (resE, scope) = State.runState (Except.runExceptT (runRenamer $ renameRules rule)) emptyScope
+    (resE, scope) = State.runState (Except.runExceptT (runRenamer $ renameRules rules)) emptyScope
   in
-    (resE, scope)
+    case resE of
+      Left err -> RenamerFail err scope
+      Right rnRules -> RenamerSuccess rnRules scope
 
 -- ----------------------------------------------------------------------------
 -- Resolve functions and their respective arities
@@ -1109,7 +1140,7 @@ oTHERWISE = "OTHERWISE"
 assertSingletonMultiTerm :: (Show (f LS.MTExpr), Foldable f) => f LS.MTExpr -> Renamer LS.MTExpr
 assertSingletonMultiTerm xs = case Foldable.toList xs of
   [x] -> pure x
-  _ -> throwError $ AssertErr $ UnexpectedNonSingletonList xs
+  _ -> throwError $ AssertErr $ UnexpectedNonSingletonList (Text.pack $ show xs)
 
 assertNoTypeSignature :: LS.TypedMulti -> Renamer (NonEmpty LS.MTExpr)
 assertNoTypeSignature tm@(_, Just _) = throwError $ AssertErr $ UnexpectedTypeSignature tm
@@ -1121,7 +1152,7 @@ assertNoTypeSignature (mtt, Nothing) = do
 -- We throwError if the list is not @'null'@.
 assertEmptyList :: (Show a) => [a] -> Renamer [b]
 assertEmptyList [] = pure []
-assertEmptyList xs = throwError $ AssertErr $ UnexpectedNonEmptyList xs
+assertEmptyList xs = throwError $ AssertErr $ UnexpectedNonEmptyList (Text.pack $ show xs)
 
 -- ----------------------------------------------------------------------------
 -- Helper utils non specific to the renamer.
diff --git a/lib/haskell/natural4/src/LS/Rule.hs b/lib/haskell/natural4/src/LS/Rule.hs
index 1bfa0f887..ea41e87fe 100644
--- a/lib/haskell/natural4/src/LS/Rule.hs
+++ b/lib/haskell/natural4/src/LS/Rule.hs
@@ -61,7 +61,6 @@ import Control.Monad.Writer.Lazy (WriterT (runWriterT))
 import Data.Aeson (ToJSON)
 import Data.Bifunctor (second)
 import Data.Generics.Product.Types (HasTypes, types)
-import Data.Graph.Inductive (Gr)
 import Data.Hashable (Hashable)
 import Data.List.NonEmpty (NonEmpty(..))
 import Data.Set qualified as Set
diff --git a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
index 14c4579ce..7886fb1d5 100644
--- a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
+++ b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
@@ -199,6 +199,9 @@ newtype Transpiler a = Transpiler {runTranspiler :: Except TranspilerError a}
   deriving newtype (Functor, Applicative, Monad)
   deriving newtype (MonadError TranspilerError)
 
+runSimalaTranspiler :: [RnRule] -> Either TranspilerError [Simala.Decl]
+runSimalaTranspiler = runExcept . runTranspiler . transpile
+
 transpile :: [RnRule] -> Transpiler [Simala.Decl]
 transpile rules = do
   simalaTerms <- Maybe.catMaybes <$> traverse ruleToSimala rules
@@ -212,6 +215,9 @@ toSimalaDecl (TermFunction t name params expr) = do
 toSimalaDecl term = do
   throwError $ TermToDeclUnsupported term
 
+render :: [Simala.Decl] -> Text
+render = Text.unlines . fmap Simala.render
+
 -- ----------------------------------------------------------------------------
 -- Main translation helpers
 -- ----------------------------------------------------------------------------
@@ -857,11 +863,11 @@ debugTranspileRule ruleSrc = do
     Right r -> pure r
   TL.putStrLn $ Pretty.pShow rule
   let
-    (res, s) = runRenamerFor $ MkSolo rule
-  TL.putStrLn $ Pretty.pShow s
-  case res of
-    Left err -> Text.putStrLn $ renderRenamerError err
-    Right (MkSolo rnRule) -> do
+    renamerResult = runRenamerFor $ MkSolo rule
+  TL.putStrLn $ Pretty.pShow $ rnResultScope renamerResult
+  case renamerResult of
+    RenamerFail err _ -> Text.putStrLn $ renderRenamerError err
+    RenamerSuccess (MkSolo rnRule) _ -> do
       TL.putStrLn $ Pretty.pShow rnRule
       case runExcept $ runTranspiler $ transpile [rnRule] of
         Left err -> Text.putStrLn $ renderTranspilerError err
@@ -872,9 +878,9 @@ transpileRulePure :: String -> Text
 transpileRulePure ruleSrc =
   case run ruleSrc of
     Left err -> Text.pack err
-    Right rule -> case fst $ runRenamerFor (MkSolo rule) of
-      Left err -> renderRenamerError err
-      Right (MkSolo rnRule) -> do
+    Right rule -> case runRenamerFor (MkSolo rule) of
+      RenamerFail err _ -> renderRenamerError err
+      RenamerSuccess (MkSolo rnRule) _ -> do
         case runExcept $ runTranspiler $ transpile [rnRule] of
           Left err -> renderTranspilerError err
           Right expr ->
diff --git a/lib/haskell/natural4/test/LS/RenamerSpec.hs b/lib/haskell/natural4/test/LS/RenamerSpec.hs
index 3a27eb0ce..f6824dc1d 100644
--- a/lib/haskell/natural4/test/LS/RenamerSpec.hs
+++ b/lib/haskell/natural4/test/LS/RenamerSpec.hs
@@ -19,6 +19,7 @@ import Text.Pretty.Simple (pShowNoColor)
 import Text.RawString.QQ (r)
 import TextuaL4.ParTextuaL (myLexer, pListRule)
 import TextuaL4.Transform
+import LS.Renamer (RenamerResult(..))
 
 goldenGeneric :: (Show a) => String -> a -> Golden TL.Text
 goldenGeneric name output_ =
@@ -116,9 +117,9 @@ spec = do
         case runList ruleSource of
           Left err -> Left $ "Failed to parse program:\n" <> ruleSource <> "\n" <> err
           Right rules ->
-            case fst $ Renamer.runRenamerFor rules of
-              Left err -> Left $ "Failed to rename program: " <> Text.unpack (Renamer.renderRenamerError err)
-              Right rnRules -> Right rnRules
+            case Renamer.runRenamerFor rules of
+              RenamerFail err _ -> Left $ "Failed to rename program: " <> Text.unpack (Renamer.renderRenamerError err)
+              RenamerSuccess rnRules _ -> Right rnRules
 
 runList :: String -> Either String [Rule]
 runList = fmap (fmap transRule) . pListRule . myLexer
diff --git a/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs b/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
index a273c14a4..aa704e5ca 100644
--- a/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
+++ b/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
@@ -14,12 +14,12 @@ import LS.Renamer qualified as Renamer
 import LS.Rule
 import LS.XPile.Logging (pShowNoColorS)
 import LS.XPile.Simala.Transpile qualified as Simala
-import Simala.Expr.Render qualified as Simala
 import System.FilePath
 import Test.Hspec
 import Test.Hspec.Golden
 import TextuaL4.ParTextuaL qualified as Parser
 import TextuaL4.Transform qualified as Parser
+import LS.Renamer (RenamerResult(..))
 
 spec :: Spec
 spec = do
@@ -239,7 +239,7 @@ transpilerTest outputName ruleString = it outputName $
           ]
       Right rules -> do
         case Renamer.runRenamerFor rules of
-          (Left err, scope) ->
+          RenamerFail err scope ->
             Text.unlines
               [ "Renaming failed for program:"
               , Text.pack ruleString
@@ -248,10 +248,10 @@ transpilerTest outputName ruleString = it outputName $
               , "Scope table:"
               , Text.pack $ pShowNoColorS scope
               ]
-          (Right rnRules, _) -> do
+          RenamerSuccess rnRules _ -> do
             case runExcept (Simala.runTranspiler $ Simala.transpile rnRules) of
               Left err -> "Failed transpilation:\n" <> Simala.renderTranspilerError err
-              Right simalaDecls -> Text.unlines $ fmap Simala.render simalaDecls
+              Right simalaDecls -> Simala.render simalaDecls
 
 goldenGeneric :: String -> Text.Text -> Golden Text.Text
 goldenGeneric name output_ =
diff --git a/lib/haskell/natural4/test/og.csv b/lib/haskell/natural4/test/og.csv
index 3b157ee21..11779b75d 100644
--- a/lib/haskell/natural4/test/og.csv
+++ b/lib/haskell/natural4/test/og.csv
@@ -24,8 +24,8 @@
 ,,,,,,,,,,,
 ,,,,,,,,,,,
 //,ChatGPT 4 prompt,,,,,,,,,,
-//,"I have a syntax for a language for Boolean expressions, formatted using comma-separated values, using indentation instead of parentheses to represent grouping. I call the language ""L4"". Expressions can span multiple lines: newlines are represented by ""\n"". The input syntax uses ""V"" to represent ""OR"", ""^"" to represent ""AND"", and ""-"" to represent ""NOT"". For example, ""foo ^ bar ^ baz"" would convert to "",foo\nAND,bar\nAND,baz"". The L4 language uses indentation instead of parentheses for grouping. We could express ""foo ^ (bar V baz)"" by saying "",foo\nAND,,bar\n,OR,baz"". Indentation really matters. Let's get it right. Another example: ""apple V banana V (carrot ^ (durian V eggplant))"" becomes "",apple,,\nOR,banana,,\nOR,,carrot,\n,AND,,durian\n,,OR,eggplant\n"".
-
+//,"I have a syntax for a language for Boolean expressions, formatted using comma-separated values, using indentation instead of parentheses to represent grouping. I call the language ""L4"". Expressions can span multiple lines: newlines are represented by ""\n"". The input syntax uses ""V"" to represent ""OR"", ""^"" to represent ""AND"", and ""-"" to represent ""NOT"". For example, ""foo ^ bar ^ baz"" would convert to "",foo\nAND,bar\nAND,baz"". The L4 language uses indentation instead of parentheses for grouping. We could express ""foo ^ (bar V baz)"" by saying "",foo\nAND,,bar\n,OR,baz"". Indentation really matters. Let's get it right. Another example: ""apple V banana V (carrot ^ (durian V eggplant))"" becomes "",apple,,\nOR,banana,,\nOR,,carrot,\n,AND,,durian\n,,OR,eggplant\n"".
+
 I will give you input. Please help me translate from the input to correctly indented L4, without changing the spaces in the terms.",,,,,,,,,,
 ,,,,,,,,,,,
 //,((is signed ^ paid premium) ^ (condition met ^ -cancelled)) ^ (claim made ^ stayed overnight ^ resulted from sickness or injury ^ us hospital ^ stay during policy period) ^ -(skydiving V military firefighter V police V 65 or older V 75 or older),,,,,,,,,,
@@ -57,7 +57,7 @@ I will give you input. Please help me translate from the input to correctly inde
 ,,,,,,,,,,,
 //,https://www.becsv.com/csv-table.php,,,to convert the above to an HTML table you can copy and paste into this spreadsheet,,,,,,,
 ,,,,,,,,,,,
-,DECIDE,Prof says covered,,,,,,,,,
+,DECIDE,Prof says covered,IS,1,,,,,,,
 ,IF,is signed,,,,,,,,,
 ,,AND,,paid premium,,,,,,,
 ,,AND,,condition met,,,,,,,
@@ -72,4 +72,4 @@ I will give you input. Please help me translate from the input to correctly inde
 ,,,OR,firefighter,,,,,,,
 ,,,OR,police,,,,,,,
 ,,,OR,65 or older,,,,,,,
-,,,OR,75 or older,,,,,,,
\ No newline at end of file
+,,,OR,75 or older,,,,,,,
diff --git a/lib/haskell/stack.yaml b/lib/haskell/stack.yaml
index 7b0ead7f4..c2a481393 100644
--- a/lib/haskell/stack.yaml
+++ b/lib/haskell/stack.yaml
@@ -32,7 +32,7 @@ extra-deps:
   commit: a6d675bcbe1585fc652f95f60e0dec826a660646
 
 - github: smucclaw/simala
-  commit: ca666a3b7155f306a9240a787910a2738b464f60
+  commit: 1cc4400e105cd8d6afa89cf742476d8303074d5f
 
 - monad-validate-1.3.0.0
 - simple-smt-0.9.7
diff --git a/lib/haskell/stack.yaml.lock b/lib/haskell/stack.yaml.lock
index 2e4216270..4eb3baf1d 100644
--- a/lib/haskell/stack.yaml.lock
+++ b/lib/haskell/stack.yaml.lock
@@ -51,14 +51,14 @@ packages:
 - completed:
     name: simala
     pantry-tree:
-      sha256: 5aeda5482faee42502897d077389e7fcfb29d3ea961e9429ea1a0a900721647a
+      sha256: 6c17834a398a7be0b232366d2dcb546507526035670f6380645ec2b45e962b1b
       size: 2422
-    sha256: 11235aef474590cd11d77369c9ccacb65cb3b1b24b3048873bccb889d91794e5
-    size: 16142
-    url: https://github.com/smucclaw/simala/archive/ca666a3b7155f306a9240a787910a2738b464f60.tar.gz
+    sha256: bd5157d4abb0b1f950a15ad43e41271e5a97a220f893e3bf0fc7283725484056
+    size: 16117
+    url: https://github.com/smucclaw/simala/archive/1cc4400e105cd8d6afa89cf742476d8303074d5f.tar.gz
     version: '0.1'
   original:
-    url: https://github.com/smucclaw/simala/archive/ca666a3b7155f306a9240a787910a2738b464f60.tar.gz
+    url: https://github.com/smucclaw/simala/archive/1cc4400e105cd8d6afa89cf742476d8303074d5f.tar.gz
 - completed:
     hackage: monad-validate-1.3.0.0@sha256:eb6ddd5c9cf72ff0563cba604fa00291376e96138fdb4932d00ff3a99d66706e,2605
     pantry-tree:

From 5e2786accfcf42d51872db19127251b6c41234bb Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Mon, 19 Aug 2024 16:28:53 +0200
Subject: [PATCH 33/44] Introduce co-log style logging for Renamer phase

---
 lib/haskell/natural4/app/Main.hs              |   4 +-
 lib/haskell/natural4/natural4.cabal           |   1 +
 lib/haskell/natural4/src/LS/Interpreter.hs    |  24 +-
 lib/haskell/natural4/src/LS/Log.hs            |  43 ++
 lib/haskell/natural4/src/LS/Renamer.hs        | 382 +++++++++++-------
 lib/haskell/natural4/src/LS/XPile/CoreL4.hs   |  15 +-
 .../natural4/src/LS/XPile/Simala/Transpile.hs |  16 +-
 lib/haskell/natural4/test/LS/RenamerSpec.hs   |  19 +-
 .../XPile/GenericMathLang/TranslateL4Spec.hs  |   4 +-
 .../natural4/test/LS/XPile/SimalaSpec.hs      |  53 +--
 .../test/Parsing/BoolStructParserSpec.hs      |  17 +-
 .../natural4/test/Parsing/CoreL4ParserSpec.hs |   9 +-
 12 files changed, 344 insertions(+), 243 deletions(-)
 create mode 100644 lib/haskell/natural4/src/LS/Log.hs

diff --git a/lib/haskell/natural4/app/Main.hs b/lib/haskell/natural4/app/Main.hs
index 5e5d19e32..a24a5111b 100644
--- a/lib/haskell/natural4/app/Main.hs
+++ b/lib/haskell/natural4/app/Main.hs
@@ -277,7 +277,7 @@ main = do
   rc       <- SFL4.getConfig opts
 --  putStrLn "main: doing dumpRules"
   rules    <- SFL4.dumpRules opts
-  let l4i  = l4interpret SFL4.defaultInterpreterOptions rules
+  l4i      <- l4interpret SFL4.defaultInterpreterOptions rules
   iso8601  <- now8601
 
   -- NLG stuff
@@ -1019,7 +1019,7 @@ jsonTranspiler =
 
 coreL4Transpiler :: Transpiler
 coreL4Transpiler =
-  simpleTranspiler "corel4" "l4" (withErrors (onlyRules (first (commentIfError "--") . xpLog . sfl4ToCorel4)))
+  simpleTranspiler "corel4" "l4" (withErrors (onlyInterpreted (first (commentIfError "--") . xpLog . sfl4ToCorel4)))
 
 babyL4Transpiler :: Transpiler
 babyL4Transpiler =
diff --git a/lib/haskell/natural4/natural4.cabal b/lib/haskell/natural4/natural4.cabal
index 8b761a115..fd5133092 100644
--- a/lib/haskell/natural4/natural4.cabal
+++ b/lib/haskell/natural4/natural4.cabal
@@ -34,6 +34,7 @@ library
       LS.Error
       LS.Interpreter
       LS.Lib
+      LS.Log
       LS.Logger
       LS.NLP.NL4
       LS.NLP.NL4Transformations
diff --git a/lib/haskell/natural4/src/LS/Interpreter.hs b/lib/haskell/natural4/src/LS/Interpreter.hs
index 84a1d88e4..c9e300bd2 100644
--- a/lib/haskell/natural4/src/LS/Interpreter.hs
+++ b/lib/haskell/natural4/src/LS/Interpreter.hs
@@ -285,24 +285,24 @@ type RuleGraph = Gr Rule RuleGraphEdgeLabel
 -- handed to each transpiler for use, as an `l4i` argument.
 --
 
-l4interpret :: InterpreterOptions -> [Rule] -> Interpreted
-l4interpret iopts rs =
+l4interpret :: InterpreterOptions -> [Rule] -> IO Interpreted
+l4interpret iopts rs = do
   let ct :: ClsTab
       ct = classHierarchy rs
       st :: ScopeTabs
       st = symbolTable    iopts rs
       (vp, _vpErr) = xpLog $ attrsAsMethods rs
       (rDGout, rDGerr) = xpLog $ ruleDecisionGraph rs
-      rnRules = Renamer.runRenamerFor rs
-  in
-    L4I { classtable = ct
-        , scopetable = st
-        , origrules  = rs
-        , renamedRules = rnRules
-        , valuePreds = fromRight [] vp
-        , ruleGraph  = rDGout
-        , ruleGraphErr = rDGerr
-        }
+  rnRules <- Renamer.runRenamerFor mempty rs
+
+  pure L4I { classtable = ct
+           , scopetable = st
+           , origrules  = rs
+           , renamedRules = rnRules
+           , valuePreds = fromRight [] vp
+           , ruleGraph  = rDGout
+           , ruleGraphErr = rDGerr
+           }
 
 -- | Provide the fully expanded, exposed, decision roots of all rules in the ruleset,
 --   grouped ("nubbed") into rule groups (since multiple rules may have the same decision body).
diff --git a/lib/haskell/natural4/src/LS/Log.hs b/lib/haskell/natural4/src/LS/Log.hs
new file mode 100644
index 000000000..c5d751207
--- /dev/null
+++ b/lib/haskell/natural4/src/LS/Log.hs
@@ -0,0 +1,43 @@
+module LS.Log (
+  -- * Logger Type and utility functions
+  Tracer (..),
+  traceWith,
+  cmap,
+  module CoFunctor,
+
+  -- * Experimental logger backends
+  prettyTracer,
+)
+where
+
+import Data.Functor.Contravariant as CoFunctor
+import Prettyprinter
+import Prettyprinter.Render.Text (renderStrict)
+import System.IO (stderr)
+import qualified Data.Text.IO as Text
+
+newtype Tracer m a = Tracer {runTracer :: a -> m ()}
+
+instance Contravariant (Tracer m) where
+  contramap f (Tracer m) = Tracer (m . f)
+
+instance (Applicative m) => Semigroup (Tracer m a) where
+  tracer1 <> tracer2 = Tracer $ \a -> runTracer tracer1 a *> runTracer tracer2 a
+
+instance (Applicative m) => Monoid (Tracer m a) where
+  mempty = Tracer $ \_ -> pure ()
+
+traceWith :: Tracer m a -> a -> m ()
+traceWith tracer msg = runTracer tracer msg
+
+-- | Shorter name for 'contramap' specialised to
+cmap :: forall a' a m. (a' -> a) -> Tracer m a -> Tracer m a'
+cmap = contramap
+
+prettyTracer :: (Pretty a) => Tracer IO a
+prettyTracer =
+  Tracer $
+    Text.hPutStrLn stderr
+      . renderStrict
+      . layoutPretty defaultLayoutOptions
+      . pretty
diff --git a/lib/haskell/natural4/src/LS/Renamer.hs b/lib/haskell/natural4/src/LS/Renamer.hs
index 57961c6ed..557a2cc40 100644
--- a/lib/haskell/natural4/src/LS/Renamer.hs
+++ b/lib/haskell/natural4/src/LS/Renamer.hs
@@ -29,15 +29,19 @@ module LS.Renamer (
   mkSimpleOccName,
 
   -- * Renamer Monad and runners
-  RenamerResult(..),
+  RenamerResult (..),
   rnResultScope,
-
   Renamer (..),
   runRenamerFor,
 
+  -- * Logging
+  Tracer,
+  liftRenamerTracer,
+  Log (..),
+
   -- * Renamer Errors
   RenamerError (..),
-  AssertionError(..),
+  AssertionError (..),
   renderRenamerError,
 
   -- * Scope checking types
@@ -77,11 +81,11 @@ import LS.Types qualified as LS
 
 import Control.Monad.Error.Class as Error
 import Control.Monad.Extra (foldM, fromMaybeM)
-import Control.Monad.State.Strict (MonadState)
+import Control.Monad.State.Strict (MonadState, MonadTrans (lift))
 import Control.Monad.Trans.Except (ExceptT)
 import Control.Monad.Trans.Except qualified as Except
-import Control.Monad.Trans.State.Strict (State)
-import Control.Monad.Trans.State.Strict qualified as State (runState)
+import Control.Monad.Trans.State.Strict (StateT)
+import Control.Monad.Trans.State.Strict qualified as State
 import Data.Foldable (traverse_)
 import Data.Foldable qualified as Foldable
 import Data.Functor (void)
@@ -95,10 +99,13 @@ import Data.Text (Text)
 import Data.Text qualified as Text
 import Data.Text.IO qualified as Text
 import Data.Text.Lazy.IO qualified as TL
+import Data.Tuple (Solo (MkSolo))
 import GHC.Generics (Generic)
+import LS.Log (traceWith)
+import LS.Log qualified as Log
 import Optics hiding (has)
+import Prettyprinter
 import Text.Pretty.Simple qualified as Pretty
-import Data.Tuple (Solo(MkSolo))
 
 -- ----------------------------------------------------------------------------
 -- Types specific to the renamer phase
@@ -229,25 +236,25 @@ data RenamerError
   | FixArityFunctionNotFound RnName [RnExpr]
   | ArityErrorLeft !Int RnName [RnExpr]
   | ArityErrorRight !Int RnName [RnExpr]
-  | -- Scope Error
-    UnexpectedNameNotFound OccName
+  | UnexpectedNameNotFound OccName
   | UnexpectedRnNameNotFound RnName
   | InsertNameUnexpectedType RnNameType RnNameType
   | LookupOrInsertNameUnexpectedType RnNameType RnNameType
   | AssertErr AssertionError
   deriving (Show, Eq, Ord)
 
-data AssertionError -- Validation Errors
-  = UnexpectedNonEmptyList Text.Text
-  -- ^ List is expected to be empty, but it wasn't!
-  -- The 'Text' parameter is a textual representation of the list that not
-  -- empty! We could use existentials (and we used to), but that makes deriving
-  -- more difficult, so I opted to the simpler solution for now.
-  | UnexpectedNonSingletonList Text.Text
-  -- ^ List is expected to be singleton list, but it wasn't!
-  -- The 'Text' parameter is a textual representation of the list that not
-  -- empty! We could use existentials (and we used to), but that makes deriving
-  -- more difficult, so I opted to the simpler solution for now.
+-- | Validation Errors
+data AssertionError
+  = -- | List is expected to be empty, but it wasn't!
+    -- The 'Text' parameter is a textual representation of the list that not
+    -- empty! We could use existentials (and we used to), but that makes deriving
+    -- more difficult, so I opted to the simpler solution for now.
+    UnexpectedNonEmptyList Text.Text
+  | -- | List is expected to be singleton list, but it wasn't!
+    -- The 'Text' parameter is a textual representation of the list that not
+    -- empty! We could use existentials (and we used to), but that makes deriving
+    -- more difficult, so I opted to the simpler solution for now.
+    UnexpectedNonSingletonList Text.Text
   | UnexpectedTypeSignature LS.TypedMulti
   deriving (Show, Eq, Ord)
 
@@ -257,27 +264,27 @@ renderRenamerError = \case
   UnsupportedRPParamText rp -> "Received 'RPParamText', we can't handle that yet. Got: " <> Text.pack (show rp)
   UnsupportedUpon pText -> "Clause \"UPON\" is currently unsupported: " <> Text.pack (show pText)
   UnknownMultiTerms mts -> "While scanning a multi term in a top-level DECIDE clause, we encountered an unsupported pattern: " <> Text.pack (show mts)
-  FixArityFunctionNotFound name list ->
-    "Invariant violated, function " <> Text.pack (show name) <> " reported, but not found in " <> Text.pack (show list)
-  ArityErrorLeft expected name list ->
+  FixArityFunctionNotFound name l ->
+    "Invariant violated, function " <> Text.pack (show name) <> " reported, but not found in " <> Text.pack (show l)
+  ArityErrorLeft expected name l ->
     "Not enough elements in left hand side of function "
       <> Text.pack (show name)
       <> ". Required: "
       <> Text.pack (show expected)
       <> " but got: "
-      <> Text.pack (show (length list))
+      <> Text.pack (show (length l))
       <> " ("
-      <> Text.pack (show list)
+      <> Text.pack (show l)
       <> ")"
-  ArityErrorRight expected name list ->
+  ArityErrorRight expected name l ->
     "Not enough elements in right hand side of function "
       <> Text.pack (show name)
       <> ". Required: "
       <> Text.pack (show expected)
       <> " but got: "
-      <> Text.pack (show (length list))
+      <> Text.pack (show (length l))
       <> " ("
-      <> Text.pack (show list)
+      <> Text.pack (show l)
       <> ")"
   -- Scope Error
   UnexpectedNameNotFound occName ->
@@ -307,13 +314,20 @@ renderAssertionError = \case
     "Expected no type signature, but got: " <> Text.pack (show tm)
 
 -- ----------------------------------------------------------------------------
--- Scope tables
+-- Renamer Main Types.
+-- Defines the 'Renamer' Monad and utility functions.
 -- ----------------------------------------------------------------------------
 
-newtype Renamer a = Renamer {runRenamer :: ExceptT RenamerError (State Scope) a}
+newtype Renamer a = Renamer {runRenamer :: ExceptT RenamerError (StateT Scope IO) a}
   deriving newtype (Functor, Applicative, Monad)
   deriving newtype (MonadState Scope, MonadError RenamerError)
 
+type Tracer a = Log.Tracer Renamer a
+
+liftRenamerTracer :: Log.Tracer IO a -> Tracer a
+liftRenamerTracer tracer = Log.Tracer $ \msg -> do
+  Renamer $ lift $ lift $ Log.runTracer tracer msg
+
 data RenamerResult a
   = RenamerFail RenamerError Scope
   | RenamerSuccess a Scope
@@ -324,11 +338,62 @@ rnResultScope :: RenamerResult a -> Scope
 rnResultScope (RenamerFail _ s) = s
 rnResultScope (RenamerSuccess _ s) = s
 
+-- ----------------------------------------------------------------------------
+-- Log Messages
+-- ----------------------------------------------------------------------------
+
+data Log
+  = LogNewRnName RnName
+  | LogNewFuncInfo RnName FuncInfo
+  | LogScopeTableForRule RuleName ScopeTable
+
+instance Pretty Log where
+  pretty = \case
+    LogNewRnName name ->
+      "Renamed name:"
+        <+> (prettyMultiTerm $ rnOccName name)
+        <+> "with id"
+        <+> pretty (rnUniqueId name)
+        <+> "with type"
+        <+> pretty (rnNameType name)
+    LogNewFuncInfo name funcInfo ->
+      "New Function Information for" <+> prettyMultiTerm (rnOccName name) <> ":" <+> pretty (_funcArity funcInfo)
+    LogScopeTableForRule name sc ->
+      "Renaming Rule with name"
+        <+> prettyMultiTerm name
+        <+> "with"
+        <+> pretty (Pretty.pShow sc)
+
+prettyMultiTerm :: (Traversable f) => f LS.MTExpr -> Doc ann
+prettyMultiTerm = list . Foldable.toList . fmap prettyMT
+
+prettyMT :: LS.MTExpr -> Doc ann
+prettyMT (LS.MTT t) = pretty t
+prettyMT (LS.MTI int) = pretty int
+prettyMT (LS.MTF float) = pretty float
+prettyMT (LS.MTB boolean) = pretty boolean
+
+instance Pretty RnNameType where
+  pretty = \case
+    RnSelector -> "Selector"
+    RnFunction -> "Function"
+    RnVariable -> "Variable"
+    RnType -> "Type"
+    RnEnum -> "Enum"
+    RnBuiltin -> "Builtin"
+
+-- ----------------------------------------------------------------------------
+-- Scope tables
+-- ----------------------------------------------------------------------------
+
 type Unique = Int
 
 -- | An unresolved name as it occurs in the original source.
 type OccName = NonEmpty LS.MTExpr
 
+mkSimpleOccName :: Text -> OccName
+mkSimpleOccName = NE.singleton . LS.MTT
+
 data FuncInfo = FuncInfo
   { _funcArity :: (Int, Int)
   -- ^ Arity of a function. The first component means how many parameters
@@ -339,8 +404,6 @@ data FuncInfo = FuncInfo
   }
   deriving (Eq, Ord, Show)
 
-mkSimpleOccName :: Text -> OccName
-mkSimpleOccName = NE.singleton . LS.MTT
 data Scope = Scope
   { _scScopeTable :: ScopeTable
   , _scUniqueSupply :: Unique
@@ -427,10 +490,10 @@ lookupExistingName occName nameType = do
 -- is already in scope with the given type.
 --
 -- Fails if the name type does not match.
-lookupOrInsertName :: OccName -> RnNameType -> Renamer RnName
-lookupOrInsertName occName nameType =
+lookupOrInsertName :: Tracer Log -> OccName -> RnNameType -> Renamer RnName
+lookupOrInsertName tracer occName nameType =
   lookupName occName >>= \case
-    Nothing -> insertName occName nameType
+    Nothing -> insertName tracer occName nameType
     Just name
       | rnNameType name == nameType -> pure name
       | otherwise ->
@@ -438,8 +501,8 @@ lookupOrInsertName occName nameType =
 
 -- | Insert an occurrence name into the current 'ScopeTable'.
 -- The new 'OccName' will overwrite (shadow?) any existing names.
-insertName :: OccName -> RnNameType -> Renamer RnName
-insertName occName nameType = do
+insertName :: Tracer Log -> OccName -> RnNameType -> Renamer RnName
+insertName tracer occName nameType = do
   n <- newUnique
   let
     rnName =
@@ -448,6 +511,7 @@ insertName occName nameType = do
         , rnOccName = occName
         , rnNameType = nameType
         }
+  traceWith tracer $ LogNewRnName rnName
   assign'
     ( scScopeTable
         % stVariables
@@ -457,8 +521,9 @@ insertName occName nameType = do
   pure rnName
 
 -- | Insert an function meta information into the current 'ScopeTable'.
-insertFunction :: RnName -> FuncInfo -> Renamer ()
-insertFunction rnFnName funcInfo =
+insertFunction :: Tracer Log -> RnName -> FuncInfo -> Renamer ()
+insertFunction tracer rnFnName funcInfo = do
+  traceWith tracer $ LogNewFuncInfo rnFnName funcInfo
   assign'
     ( scScopeTable
         % stFunction
@@ -519,21 +584,18 @@ notInSelectorContext mtc = mtc & inSelector .~ False
 renameRuleTopLevel :: Rule -> IO ()
 renameRuleTopLevel rule = do
   TL.putStrLn $ Pretty.pShow rule
-  let
-    renamerResult = runRenamerFor (MkSolo rule)
+  renamerResult <- runRenamerFor (liftRenamerTracer Log.prettyTracer) (MkSolo rule)
   TL.putStrLn $ Pretty.pShow $ rnResultScope renamerResult
   case renamerResult of
     RenamerFail err _ -> Text.putStrLn $ renderRenamerError err
     RenamerSuccess (MkSolo rnRules) _ -> TL.putStrLn $ Pretty.pShow rnRules
 
-runRenamerFor :: (Traversable f) => f Rule -> RenamerResult (f RnRule)
-runRenamerFor rules =
-  let
-    (resE, scope) = State.runState (Except.runExceptT (runRenamer $ renameRules rules)) emptyScope
-  in
-    case resE of
-      Left err -> RenamerFail err scope
-      Right rnRules -> RenamerSuccess rnRules scope
+runRenamerFor :: (Traversable f) => Tracer Log -> f Rule -> IO (RenamerResult (f RnRule))
+runRenamerFor tracer rules = do
+  (resE, scope) <- State.runStateT (Except.runExceptT (runRenamer $ renameRules tracer rules)) emptyScope
+  pure $ case resE of
+    Left err -> RenamerFail err scope
+    Right rnRules -> RenamerSuccess rnRules scope
 
 -- ----------------------------------------------------------------------------
 -- Resolve functions and their respective arities
@@ -549,36 +611,36 @@ runRenamerFor rules =
 --
 -- 'scanRule' produces a 'ScopeTable' of items that are exported from this rule.
 -- Further, 'scanRule' may only *add* new names to the 'ScopeTable'.
-scanRule :: Rule -> Renamer ScopeTable
-scanRule rule@Rule.Hornlike{} = do
-  scanGivens rule.given
+scanRule :: Tracer Log -> Rule -> Renamer ScopeTable
+scanRule tracer rule@Rule.Hornlike{} = do
+  scanGivens tracer rule.given
   exports <- recordScopeTable_ $ do
-    scanGiveths rule.giveth
-    traverse_ scanHornClause rule.clauses
+    scanGiveths tracer rule.giveth
+    traverse_ (scanHornClause tracer) rule.clauses
   pure exports
-scanRule r@Rule.Regulative{} = throwError $ UnsupportedRule "scanRule" r
-scanRule r@Rule.Constitutive{} = throwError $ UnsupportedRule "scanRule" r
-scanRule rule@Rule.TypeDecl{} = do
-  traverse_ scanTypeSignature rule.super
-  scanEnums rule.enums
-  scanGivens rule.given
-  traverse_ scanRule rule.has
-  scanTypeDeclName rule.name
+scanRule _ r@Rule.Regulative{} = throwError $ UnsupportedRule "scanRule" r
+scanRule _ r@Rule.Constitutive{} = throwError $ UnsupportedRule "scanRule" r
+scanRule tracer rule@Rule.TypeDecl{} = do
+  traverse_ (scanTypeSignature tracer) rule.super
+  scanEnums tracer rule.enums
+  scanGivens tracer rule.given
+  traverse_ (scanRule tracer) rule.has
+  scanTypeDeclName tracer rule.name
   typeScope <- use scScopeTable
   pure typeScope
-scanRule r@Rule.Scenario{} = throwError $ UnsupportedRule "scanRule" r
-scanRule r@Rule.DefNameAlias{} = throwError $ UnsupportedRule "scanRule" r
-scanRule r@Rule.DefTypically{} = throwError $ UnsupportedRule "scanRule" r
-scanRule r@Rule.RuleAlias{} = throwError $ UnsupportedRule "scanRule" r
-scanRule r@Rule.RuleGroup{} = throwError $ UnsupportedRule "scanRule" r
-scanRule r@Rule.RegFulfilled{} = throwError $ UnsupportedRule "scanRule" r
-scanRule r@Rule.RegBreach{} = throwError $ UnsupportedRule "scanRule" r
-scanRule r@Rule.NotARule{} = throwError $ UnsupportedRule "scanRule" r
+scanRule _ r@Rule.Scenario{} = throwError $ UnsupportedRule "scanRule" r
+scanRule _ r@Rule.DefNameAlias{} = throwError $ UnsupportedRule "scanRule" r
+scanRule _ r@Rule.DefTypically{} = throwError $ UnsupportedRule "scanRule" r
+scanRule _ r@Rule.RuleAlias{} = throwError $ UnsupportedRule "scanRule" r
+scanRule _ r@Rule.RuleGroup{} = throwError $ UnsupportedRule "scanRule" r
+scanRule _ r@Rule.RegFulfilled{} = throwError $ UnsupportedRule "scanRule" r
+scanRule _ r@Rule.RegBreach{} = throwError $ UnsupportedRule "scanRule" r
+scanRule _ r@Rule.NotARule{} = throwError $ UnsupportedRule "scanRule" r
 
 -- | Scan a 'LS.HornClause2' for declarations of variables and functions.
-scanHornClause :: LS.HornClause2 -> Renamer ()
-scanHornClause hc = do
-  scanDecideHeadClause hc.hHead
+scanHornClause :: Tracer Log -> LS.HornClause2 -> Renamer ()
+scanHornClause tracer hc = do
+  scanDecideHeadClause tracer hc.hHead
 
 -- | Scan the head of relational predicates that occur in
 -- the head of @DECIDE clauses@, e.g. @DECIDE foo IS bar@.
@@ -586,14 +648,14 @@ scanHornClause hc = do
 -- We detect the occurrence of @IS@ and treat it in a special way,
 -- and in the case of a multi-term, we use 'scanDecideMultiTerm'
 -- which allows the *introduction* of variables.
-scanDecideHeadClause :: LS.RelationalPredicate -> Renamer ()
-scanDecideHeadClause = \case
+scanDecideHeadClause :: Tracer Log -> LS.RelationalPredicate -> Renamer ()
+scanDecideHeadClause tracer = \case
   LS.RPParamText pText -> throwError $ UnsupportedRPParamText pText --  $ "Received 'RPParamText', we can't handle that yet. Got: " <> show pText
-  LS.RPMT mt -> scanDecideMultiTerm mt
+  LS.RPMT mt -> scanDecideMultiTerm tracer mt
   LS.RPConstraint lhs _predicate _rhs -> do
-    scanDecideMultiTerm lhs
+    scanDecideMultiTerm tracer lhs
   LS.RPBoolStructR lhs _predicate _rhs -> do
-    scanDecideMultiTerm lhs
+    scanDecideMultiTerm tracer lhs
   LS.RPnary LS.RPis (lhs : _rhs) -> do
     -- When the assignment has multiple complicated relational predicates,
     -- it is translated to this 'RPNary'. Then the first element is before the 'IS'
@@ -603,7 +665,7 @@ scanDecideHeadClause = \case
     -- is parsed to @RPnary RPis [[f, x], [RPnary RPSum [x, x, x]]]@
     -- ignoring some details.
     -- Thus, we scan the first item of 'IS' predicates.
-    scanDecideHeadClause lhs
+    scanDecideHeadClause tracer lhs
   LS.RPnary _predicate _rhs -> do
     pure ()
 
@@ -627,20 +689,20 @@ scanDecideHeadClause = \case
 -- * @x@: a variable, might be bound ad-hoc
 --
 -- Note, this doesn't accept literals such as '42' or '3.5f' or True or False.
-scanDecideMultiTerm :: LS.MultiTerm -> Renamer ()
-scanDecideMultiTerm mt = do
+scanDecideMultiTerm :: Tracer Log -> LS.MultiTerm -> Renamer ()
+scanDecideMultiTerm tracer mt = do
   scopeTable <- use scScopeTable
   case mt of
     attrs
       | Just (obj, objAttrs) <- toObjectPath attrs -> do
           -- DECIDE x IS ...
           -- DECIDE x's y's z IS ...
-          _ <- lookupOrInsertName (mkSimpleOccName obj) RnVariable
-          traverse_ (\attr -> RnExprName <$> lookupOrInsertName (mkSimpleOccName attr) RnSelector) objAttrs
+          _ <- lookupOrInsertName tracer (mkSimpleOccName obj) RnVariable
+          traverse_ (\attr -> RnExprName <$> lookupOrInsertName tracer (mkSimpleOccName attr) RnSelector) objAttrs
     fnDecl
       | Just (fnOccName, preArgs, postArgs) <- scanForFunctionDecl scopeTable fnDecl -> do
-          rnF <- lookupOrInsertName fnOccName RnFunction
-          insertFunction rnF (FuncInfo{_funcArity = (preArgs, postArgs)})
+          rnF <- lookupOrInsertName tracer fnOccName RnFunction
+          insertFunction tracer rnF (FuncInfo{_funcArity = (preArgs, postArgs)})
     unknownPattern -> throwError $ UnknownMultiTerms unknownPattern
 
 -- throwError $ "While scanning a multi term in a top-level DECIDE clause, we encountered an unsupported pattern: " <> show unknownPattern
@@ -674,50 +736,54 @@ scanForFunctionDecl scopeTable mts = do
   isVariable _ = False
 
 scanGiveths ::
+  Tracer Log ->
   Maybe LS.ParamText ->
   Renamer ()
 scanGiveths = scanGivens
 
 scanEnums ::
+  Tracer Log ->
   Maybe LS.ParamText ->
   Renamer ()
-scanEnums = traverse_ scanGivenInlineEnumParamText
+scanEnums tracer = traverse_ (scanGivenInlineEnumParamText tracer)
 
 scanGivens ::
+  Tracer Log ->
   Maybe LS.ParamText ->
   Renamer ()
-scanGivens Nothing = pure ()
-scanGivens (Just givens) = do
-  traverse_ scanGiven givens
+scanGivens _ Nothing = pure ()
+scanGivens tracer (Just givens) = do
+  traverse_ (scanGiven tracer) givens
 
-scanGiven :: LS.TypedMulti -> Renamer ()
-scanGiven (mtExprs, typeSig) = do
-  scanGivenMultiTerm mtExprs
-  traverse_ scanTypeSignature typeSig
+scanGiven :: Tracer Log -> LS.TypedMulti -> Renamer ()
+scanGiven tracer (mtExprs, typeSig) = do
+  scanGivenMultiTerm tracer mtExprs
+  traverse_ (scanTypeSignature tracer) typeSig
 
-scanGivenMultiTerm :: NonEmpty LS.MTExpr -> Renamer ()
-scanGivenMultiTerm mtExprs = do
+scanGivenMultiTerm :: Tracer Log -> NonEmpty LS.MTExpr -> Renamer ()
+scanGivenMultiTerm tracer mtExprs = do
   mt <- assertSingletonMultiTerm mtExprs
-  void $ insertName (pure mt) RnVariable
+  void $ insertName tracer (pure mt) RnVariable
 
 scanTypeSignature ::
+  Tracer Log ->
   LS.TypeSig ->
   Renamer ()
-scanTypeSignature sig = case sig of
+scanTypeSignature tracer sig = case sig of
   LS.SimpleType _pType entityType -> do
     scanEntityType entityType
   LS.InlineEnum _pType paramText -> do
     -- TODO: error handling, would we accept an enum such as `a IS ONE OF 1, 2, 3`?
     -- Only if we treat them as text, which might be confusing, as user might infer
     -- this to be some kind of type checked number type.
-    scanGivenInlineEnumParamText paramText
+    scanGivenInlineEnumParamText tracer paramText
  where
   scanEntityType :: LS.EntityType -> Renamer ()
   scanEntityType eType =
     -- This can either refer to an existing entity type, or define a new,
     -- ad-hoc, entity type. We just assume that multiple ad-hoc definitions
     -- of the same name in the same scope must be consistent.
-    void $ lookupOrInsertName (mkSimpleOccName eType) RnType
+    void $ lookupOrInsertName tracer (mkSimpleOccName eType) RnType
 
 -- | Scan for names in the enum definition.
 --
@@ -747,12 +813,12 @@ scanTypeSignature sig = case sig of
 -- ANDRES: I think the fact that type signatures allow nested
 -- type signatures is a shortcoming of the input syntax that should
 -- be fixed at that level.
-scanGivenInlineEnumParamText :: LS.ParamText -> Renamer ()
-scanGivenInlineEnumParamText params = do
+scanGivenInlineEnumParamText :: Tracer Log -> LS.ParamText -> Renamer ()
+scanGivenInlineEnumParamText tracer params = do
   let
     scanEach tm = do
       mt <- assertNoTypeSignature tm
-      enumNames <- traverse (\t -> insertName (NE.singleton t) RnEnum) mt
+      enumNames <- traverse (\t -> insertName tracer (NE.singleton t) RnEnum) mt
       pure $
         RnTypedMulti
           { rnTypedMultiExpr = fmap RnExprName enumNames
@@ -761,10 +827,10 @@ scanGivenInlineEnumParamText params = do
 
   traverse_ scanEach params
 
-scanTypeDeclName :: RuleName -> Renamer ()
-scanTypeDeclName mtexprs = do
+scanTypeDeclName :: Tracer Log -> RuleName -> Renamer ()
+scanTypeDeclName tracer mtexprs = do
   mt <- assertSingletonMultiTerm mtexprs
-  void $ insertName (NE.singleton mt) RnType
+  void $ insertName tracer (NE.singleton mt) RnType
 
 -- ----------------------------------------------------------------------------
 -- Renamer passes
@@ -776,13 +842,13 @@ scanTypeDeclName mtexprs = do
 -- GIVETH's are global
 -- GIVEN's are local
 -- DECIDE head term in "IS" clauses is global
-renameRules :: (Traversable f) => f Rule -> Renamer (f RnRule)
-renameRules rules = do
+renameRules :: (Traversable f) => Tracer Log -> f Rule -> Renamer (f RnRule)
+renameRules tracer rules = do
   rulesWithLocalDefs <-
     traverse
       ( \r -> do
           prev <- use scScopeTable
-          exportedScope <- scanRule r
+          exportedScope <- scanRule tracer r
           fullRuleScope <- use scScopeTable
           assign' scScopeTable (prev `unionScopeTable` exportedScope)
           pure (r, fullRuleScope)
@@ -792,23 +858,24 @@ renameRules rules = do
     ( \(r, ruleScope) -> do
         orig <- use scScopeTable
         modifying' scScopeTable (`unionScopeTable` ruleScope)
-        rnRule <- renameRule r
+        rnRule <- renameRule tracer r
         assign' scScopeTable orig
         pure rnRule
     )
     rulesWithLocalDefs
 
-renameRule :: Rule -> Renamer RnRule
-renameRule rule@Rule.Hornlike{} = do
+renameRule :: Tracer Log -> Rule -> Renamer RnRule
+renameRule tracer rule@Rule.Hornlike{} = do
+  traceWith tracer . LogScopeTableForRule rule.name =<< use scScopeTable
   super <- traverse renameTypeSignature rule.super
   given <- renameGivens rule.given
   giveth <- renameGiveths rule.giveth
-  wwhere <- renameLocalRules rule.wwhere
+  wwhere <- renameLocalRules tracer rule.wwhere
   upon <- renameUpons rule.upon
   defaults <- assertEmptyList rule.defaults
   symtab <- assertEmptyList rule.symtab
-  clauses <- traverse renameHornClause rule.clauses
-  name <- renameMultiTerm rule.name
+  clauses <- traverse (renameHornClause tracer) rule.clauses
+  name <- renameMultiTerm tracer rule.name
   pure $
     Hornlike
       RnHornlike
@@ -826,16 +893,17 @@ renameRule rule@Rule.Hornlike{} = do
         , defaults
         , symtab
         }
-renameRule r@Rule.Regulative{} = throwError $ UnsupportedRule "renameRule" r
-renameRule r@Rule.Constitutive{} = throwError $ UnsupportedRule "renameRule" r
-renameRule rule@Rule.TypeDecl{} = do
+renameRule _ r@Rule.Regulative{} = throwError $ UnsupportedRule "renameRule" r
+renameRule _ r@Rule.Constitutive{} = throwError $ UnsupportedRule "renameRule" r
+renameRule tracer rule@Rule.TypeDecl{} = do
+  traceWith tracer . LogScopeTableForRule rule.name =<< use scScopeTable
   super <- traverse renameTypeSignature rule.super
   defaults <- assertEmptyList rule.defaults
   enums <- renameEnums rule.enums
   given <- renameGivens rule.given
   upon <- renameUpons rule.upon
   symtab <- assertEmptyList rule.symtab
-  has <- traverse renameRule rule.has
+  has <- traverse (renameRule tracer) rule.has
   name <- renameTypeDeclName rule.name
   pure $
     TypeDecl
@@ -852,16 +920,16 @@ renameRule rule@Rule.TypeDecl{} = do
         , defaults
         , symtab
         }
-renameRule r@Rule.Scenario{} = throwError $ UnsupportedRule "renameRule" r
-renameRule r@Rule.DefNameAlias{} = throwError $ UnsupportedRule "renameRule" r
-renameRule r@Rule.DefTypically{} = throwError $ UnsupportedRule "renameRule" r
-renameRule r@Rule.RuleAlias{} = throwError $ UnsupportedRule "renameRule" r
-renameRule r@Rule.RuleGroup{} = throwError $ UnsupportedRule "renameRule" r
-renameRule r@Rule.RegFulfilled{} = throwError $ UnsupportedRule "renameRule" r
-renameRule r@Rule.RegBreach{} = throwError $ UnsupportedRule "renameRule" r
-renameRule r@Rule.NotARule{} = throwError $ UnsupportedRule "renameRule" r
-
-renameLocalRules :: [Rule] -> Renamer [RnRule]
+renameRule _ r@Rule.Scenario{} = throwError $ UnsupportedRule "renameRule" r
+renameRule _ r@Rule.DefNameAlias{} = throwError $ UnsupportedRule "renameRule" r
+renameRule _ r@Rule.DefTypically{} = throwError $ UnsupportedRule "renameRule" r
+renameRule _ r@Rule.RuleAlias{} = throwError $ UnsupportedRule "renameRule" r
+renameRule _ r@Rule.RuleGroup{} = throwError $ UnsupportedRule "renameRule" r
+renameRule _ r@Rule.RegFulfilled{} = throwError $ UnsupportedRule "renameRule" r
+renameRule _ r@Rule.RegBreach{} = throwError $ UnsupportedRule "renameRule" r
+renameRule _ r@Rule.NotARule{} = throwError $ UnsupportedRule "renameRule" r
+
+renameLocalRules :: Tracer Log -> [Rule] -> Renamer [RnRule]
 renameLocalRules = renameRules
 
 renameTypeDeclName :: RuleName -> Renamer RnRuleName
@@ -938,43 +1006,43 @@ renameGivenInlineEnumParamText params = do
   rnParams <- traverse renameEach params
   pure $ RnParamText rnParams
 
-renameHornClause :: LS.HornClause2 -> Renamer RnHornClause
-renameHornClause hc = do
-  rnHead <- renameRelationalPredicate hc.hHead
-  rnBody <- traverse renameBoolStruct hc.hBody
+renameHornClause :: Tracer Log -> LS.HornClause2 -> Renamer RnHornClause
+renameHornClause tracer hc = do
+  rnHead <- renameRelationalPredicate tracer hc.hHead
+  rnBody <- traverse (renameBoolStruct tracer) hc.hBody
   pure $
     RnHornClause
       { rnHcHead = rnHead
       , rnHcBody = rnBody
       }
 
-renameRelationalPredicate :: LS.RelationalPredicate -> Renamer RnRelationalPredicate
-renameRelationalPredicate = \case
+renameRelationalPredicate :: Tracer Log -> LS.RelationalPredicate -> Renamer RnRelationalPredicate
+renameRelationalPredicate tracer = \case
   LS.RPParamText pText ->
     throwError $ UnsupportedRPParamText pText
-  LS.RPMT mt -> RnRelationalTerm <$> renameMultiTerm mt
+  LS.RPMT mt -> RnRelationalTerm <$> renameMultiTerm tracer mt
   LS.RPConstraint lhs relationalPredicate rhs -> do
-    rnLhs <- renameMultiTerm lhs
-    rnRhs <- renameMultiTerm rhs
+    rnLhs <- renameMultiTerm tracer lhs
+    rnRhs <- renameMultiTerm tracer rhs
     pure $ RnConstraint rnLhs relationalPredicate rnRhs
   LS.RPBoolStructR lhs relationalPredicate rhs -> do
-    rnLhs <- renameMultiTerm lhs
-    rnRhs <- renameBoolStruct rhs
+    rnLhs <- renameMultiTerm tracer lhs
+    rnRhs <- renameBoolStruct tracer rhs
     pure $ RnBoolStructR rnLhs relationalPredicate rnRhs
   LS.RPnary relationalPredicate rhs -> do
-    rnRhs <- traverse renameRelationalPredicate rhs
+    rnRhs <- traverse (renameRelationalPredicate tracer) rhs
     pure $ RnNary relationalPredicate rnRhs
 
-renameBoolStruct :: LS.BoolStructR -> Renamer RnBoolStructR
-renameBoolStruct = \case
-  AA.Leaf p -> AA.Leaf <$> renameRelationalPredicate p
+renameBoolStruct :: Tracer Log -> LS.BoolStructR -> Renamer RnBoolStructR
+renameBoolStruct tracer = \case
+  AA.Leaf p -> AA.Leaf <$> renameRelationalPredicate tracer p
   AA.All lbl cs -> do
-    rnBoolStruct <- traverse renameBoolStruct cs
+    rnBoolStruct <- traverse (renameBoolStruct tracer) cs
     pure $ AA.All lbl rnBoolStruct
   AA.Any lbl cs -> do
-    rnBoolStruct <- traverse renameBoolStruct cs
+    rnBoolStruct <- traverse (renameBoolStruct tracer) cs
     pure $ AA.Any lbl rnBoolStruct
-  AA.Not cs -> AA.Not <$> renameBoolStruct cs
+  AA.Not cs -> AA.Not <$> (renameBoolStruct tracer) cs
 
 -- | Rename a 'LS.MultiTerm' and turn each 'LS.MTExpr' into a 'RnExpr'.
 --
@@ -998,12 +1066,12 @@ renameBoolStruct = \case
 -- For example, @[MTT "x", MTT "f"]@ will be changed @[MTT "f", MTT "x"]@,
 -- if and only if @"f"@ is a known function variable in scope with associated
 -- arity information.
-renameMultiTerm :: LS.MultiTerm -> Renamer RnMultiTerm
-renameMultiTerm multiTerms = do
+renameMultiTerm :: Tracer Log -> LS.MultiTerm -> Renamer RnMultiTerm
+renameMultiTerm tracer multiTerms = do
   (reversedRnMultiTerms, ctx) <-
     foldM
       ( \(results, state) mt -> do
-          (rnExpr, newState) <- renameMultiTermExpression state mt
+          (rnExpr, newState) <- renameMultiTermExpression tracer state mt
           pure (rnExpr : results, newState)
       )
       ([], initialMultiTermContext)
@@ -1050,8 +1118,8 @@ renameMultiTerm multiTerms = do
       }
 
 -- | Rename a single 'LS.MTExpr' to a 'RnExpr'.
-renameMultiTermExpression :: MultiTermContext -> LS.MTExpr -> Renamer (RnExpr, MultiTermContext)
-renameMultiTermExpression ctx = \case
+renameMultiTermExpression :: Tracer Log -> MultiTermContext -> LS.MTExpr -> Renamer (RnExpr, MultiTermContext)
+renameMultiTermExpression tracer ctx = \case
   -- TODO: this could be an expression such as "2+2" (for whatever reason), so perhaps
   -- we need to parse this further. Allegedly, we also want to support
   -- expressions nested into one csv-cell, for example:
@@ -1079,10 +1147,10 @@ renameMultiTermExpression ctx = \case
               -- ANDRES: I'm not convinced that built-ins should be renamed, and
               -- if we already detected that they're built-ins, perhaps we should
               -- just use a different dedicated constructor for this case.
-              rnName <- RnExprName <$> rnL4Builtin name
+              rnName <- RnExprName <$> rnL4Builtin tracer name
               pure (rnName, ctx')
           | ctx ^. inSelector -> do
-              rnName <- RnExprName <$> insertName (mkSimpleOccName name) RnSelector
+              rnName <- RnExprName <$> insertName tracer (mkSimpleOccName name) RnSelector
               pure (rnName, ctx')
           | otherwise -> do
               -- If this is not a selector, or a known variable, we infer
@@ -1101,7 +1169,7 @@ renameMultiTermExpression ctx = \case
       -- @
       --
       -- Then 'y' and 'z' are anonymous selectors for 'x'.
-      rnName <- fromMaybeM (lookupOrInsertName (mkSimpleOccName nameSelector) RnSelector) (lookupName (mkSimpleOccName nameSelector))
+      rnName <- fromMaybeM (lookupOrInsertName tracer (mkSimpleOccName nameSelector) RnSelector) (lookupName (mkSimpleOccName nameSelector))
       pure (RnExprName rnName, inSelectorContext ctx)
   LS.MTI int -> pure (RnExprLit $ RnInt int, notInSelectorContext ctx)
   LS.MTF double -> pure (RnExprLit $ RnDouble double, notInSelectorContext ctx)
@@ -1121,9 +1189,9 @@ renameMultiTermExpression ctx = \case
 isL4BuiltIn :: Text -> Bool
 isL4BuiltIn name = Set.member name (Set.fromList l4Builtins)
 
-rnL4Builtin :: Text -> Renamer RnName
-rnL4Builtin name = do
-  lookupOrInsertName (mkSimpleOccName name) RnBuiltin
+rnL4Builtin :: Tracer Log -> Text -> Renamer RnName
+rnL4Builtin tracer name = do
+  lookupOrInsertName tracer (mkSimpleOccName name) RnBuiltin
 
 l4Builtins :: [Text]
 l4Builtins = [oTHERWISE]
diff --git a/lib/haskell/natural4/src/LS/XPile/CoreL4.hs b/lib/haskell/natural4/src/LS/XPile/CoreL4.hs
index 26455e5c8..f7da1d570 100644
--- a/lib/haskell/natural4/src/LS/XPile/CoreL4.hs
+++ b/lib/haskell/natural4/src/LS/XPile/CoreL4.hs
@@ -94,7 +94,6 @@ import LS.Interpreter as SFL4
     classGraph,
     getAttrTypesIn,
     getCTkeys,
-    l4interpret,
   )
 import LS.PrettyPrinter
   ( RP1 (RP1),
@@ -149,7 +148,6 @@ import LS.Types as SFL4
     ClsTab (..),
     HornClause (HC, hBody, hHead),
     HornClause2,
-    InterpreterOptions (enums2decls),
     MTExpr (..),
     MultiTerm,
     MyToken (Decide, Define),
@@ -162,7 +160,6 @@ import LS.Types as SFL4
     SrcRef (SrcRef, short, srccol, srcrow, url, version),
     TypeSig (..),
     clsParent,
-    defaultInterpreterOptions,
     enumLabels_,
     getSymType,
     getUnderlyingType,
@@ -252,11 +249,9 @@ sfl4ToLogicProgramStr (otoList -> rules) =
 sfl4ToDMN :: [SFL4.Rule] -> HXT.IOSLA (HXT.XIOState ()) HXT.XmlTree HXT.XmlTree
 sfl4ToDMN rules = rules |> sfl4ToUntypedBabyL4 |> genXMLTreeNoType
 
-sfl4ToCorel4 :: [SFL4.Rule] -> XPileLogE String
-sfl4ToCorel4 rs =
-  let interpreted =
-        l4interpret (defaultInterpreterOptions { enums2decls = True }) rs
-      -- sTable = scopetable interpreted
+sfl4ToCorel4 :: Interpreted -> XPileLogE String
+sfl4ToCorel4 interpreted =
+  let
       cTable = classtable interpreted
       pclasses = myrender $ prettyClasses cTable
       pBoilerplate = myrender $ prettyBoilerplate cTable
@@ -285,7 +280,7 @@ sfl4ToCorel4 rs =
     , "\n\n## boilerplate\n",               T.unpack pBoilerplate
 
     , "\n\n## decls for predicates used in rules (and not defined above already)\n"
-    , T.unpack . myrender $ prettyDecls [i|#{hardCoded}#{pclasses}#{pBoilerplate}|] rs
+    , T.unpack . myrender $ prettyDecls [i|#{hardCoded}#{pclasses}#{pBoilerplate}|] $ origrules interpreted
 
     -- honestly i think we can just live without these
     --               , "\n\n## facts\n",                     show $ prettyFacts   sTable
@@ -294,7 +289,7 @@ sfl4ToCorel4 rs =
     , "\n# directToCore\n\n"
     ] ++
     [ T.unpack $ myrender $ directToCore r
-    | r <- rs
+    | r <- origrules interpreted
     ]
   )
   where
diff --git a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
index 7886fb1d5..6e75f7831 100644
--- a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
+++ b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
@@ -31,6 +31,7 @@ import TextuaL4.Transform qualified as Parser
 
 import AnyAll.BoolStruct qualified as AA
 
+import LS.Log qualified as Log
 import Simala.Expr.Parser qualified as Simala
 import Simala.Expr.Render qualified as Simala
 import Simala.Expr.Type qualified as Simala
@@ -862,8 +863,7 @@ debugTranspileRule ruleSrc = do
       fail "translation failed"
     Right r -> pure r
   TL.putStrLn $ Pretty.pShow rule
-  let
-    renamerResult = runRenamerFor $ MkSolo rule
+  renamerResult <- runRenamerFor (liftRenamerTracer Log.prettyTracer) $ MkSolo rule
   TL.putStrLn $ Pretty.pShow $ rnResultScope renamerResult
   case renamerResult of
     RenamerFail err _ -> Text.putStrLn $ renderRenamerError err
@@ -874,18 +874,6 @@ debugTranspileRule ruleSrc = do
         Right decls -> flip Foldable.traverse_ decls $ \decl -> do
           Text.putStrLn $ "Decl: " <> Simala.render decl
 
-transpileRulePure :: String -> Text
-transpileRulePure ruleSrc =
-  case run ruleSrc of
-    Left err -> Text.pack err
-    Right rule -> case runRenamerFor (MkSolo rule) of
-      RenamerFail err _ -> renderRenamerError err
-      RenamerSuccess (MkSolo rnRule) _ -> do
-        case runExcept $ runTranspiler $ transpile [rnRule] of
-          Left err -> renderTranspilerError err
-          Right expr ->
-            Text.unlines $ fmap Simala.render expr
-
 run :: String -> Either String LS.Rule
 run = fmap Parser.transRule . Parser.pRule . Parser.myLexer
 
diff --git a/lib/haskell/natural4/test/LS/RenamerSpec.hs b/lib/haskell/natural4/test/LS/RenamerSpec.hs
index f6824dc1d..4b2895dfa 100644
--- a/lib/haskell/natural4/test/LS/RenamerSpec.hs
+++ b/lib/haskell/natural4/test/LS/RenamerSpec.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# OPTIONS_GHC -Wall #-}
+{-# LANGUAGE LambdaCase #-}
 
 module LS.RenamerSpec (spec) where
 
@@ -110,16 +111,16 @@ spec = do
         DECIDE x g IS x
         |]
  where
-  test' :: String -> String -> SpecWith (Arg (Golden TL.Text))
-  test' fname ruleSource = do
-    it fname $
-      goldenGeneric fname $
-        case runList ruleSource of
-          Left err -> Left $ "Failed to parse program:\n" <> ruleSource <> "\n" <> err
+  test' :: String -> String -> SpecWith (Arg (IO (Golden TL.Text)))
+  test' fname ruleSource =
+    it fname $ do
+      result <- case runList ruleSource of
+          Left err -> pure $ Left $ "Failed to parse program:\n" <> ruleSource <> "\n" <> err
           Right rules ->
-            case Renamer.runRenamerFor rules of
-              RenamerFail err _ -> Left $ "Failed to rename program: " <> Text.unpack (Renamer.renderRenamerError err)
-              RenamerSuccess rnRules _ -> Right rnRules
+            Renamer.runRenamerFor mempty rules >>= \case
+              RenamerFail err _ -> pure $ Left $ "Failed to rename program: " <> Text.unpack (Renamer.renderRenamerError err)
+              RenamerSuccess rnRules _ -> pure $ Right rnRules
+      pure $ goldenGeneric fname result
 
 runList :: String -> Either String [Rule]
 runList = fmap (fmap transRule) . pListRule . myLexer
diff --git a/lib/haskell/natural4/test/LS/XPile/GenericMathLang/TranslateL4Spec.hs b/lib/haskell/natural4/test/LS/XPile/GenericMathLang/TranslateL4Spec.hs
index b137cac88..771d1418f 100644
--- a/lib/haskell/natural4/test/LS/XPile/GenericMathLang/TranslateL4Spec.hs
+++ b/lib/haskell/natural4/test/LS/XPile/GenericMathLang/TranslateL4Spec.hs
@@ -28,7 +28,7 @@ import LS.XPile.MathLang.GenericMathLang.GenericMathLangAST qualified as GML
 import LS.XPile.MathLang.GenericMathLang.TranslateL4
 import LS.XPile.MathLang.MathLang qualified as ML
 import LS.XPile.MathLang.GenericMathLang.ToGenericMathLang (toMathLangGen, expandHornlikes, getHornlikes)
-import Test.Hspec (Spec, describe, it, shouldBe, xit)
+import Test.Hspec (Spec, describe, it, shouldBe, xit, runIO)
 import Test.Hspec.Golden
 import TextuaL4.Transform    ( transRule )
 import TextuaL4.ParTextuaL   ( pRule, myLexer )
@@ -251,7 +251,7 @@ spec = do
           res `shouldBe` 550.0
 
   describe "mustsing5" do
-    let l4i = l4interpret defaultInterpreterOptions mustsing5
+    l4i <- runIO $ l4interpret defaultInterpreterOptions mustsing5
 
     it "should expand hornlikes from Must Sing 5" $ goldenGeneric "mustSingHornlikesExpanded" do
         expandHornlikes l4i (getHornlikes l4i)
diff --git a/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs b/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
index aa704e5ca..8b7e4ef86 100644
--- a/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
+++ b/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# OPTIONS_GHC -Wall #-}
+{-# LANGUAGE LambdaCase #-}
 
 module LS.XPile.SimalaSpec (spec) where
 
@@ -226,32 +227,32 @@ IF
         )
         |]
 
-transpilerTest :: String -> String -> SpecWith (Arg (Golden TL.Text))
-transpilerTest outputName ruleString = it outputName $
-  goldenGeneric outputName $
-    case runList ruleString of
-      Left err ->
-        Text.unlines
-          [ "Failed to parse program:"
-          , Text.pack ruleString
-          , "Err:"
-          , Text.pack err
-          ]
-      Right rules -> do
-        case Renamer.runRenamerFor rules of
-          RenamerFail err scope ->
-            Text.unlines
-              [ "Renaming failed for program:"
-              , Text.pack ruleString
-              , "Because:"
-              , Renamer.renderRenamerError err
-              , "Scope table:"
-              , Text.pack $ pShowNoColorS scope
-              ]
-          RenamerSuccess rnRules _ -> do
-            case runExcept (Simala.runTranspiler $ Simala.transpile rnRules) of
-              Left err -> "Failed transpilation:\n" <> Simala.renderTranspilerError err
-              Right simalaDecls -> Simala.render simalaDecls
+transpilerTest :: String -> String -> SpecWith (Arg (IO (Golden TL.Text)))
+transpilerTest outputName ruleString = it outputName $ do
+  result <- case runList ruleString of
+    Left err -> pure $
+      Text.unlines
+        [ "Failed to parse program:"
+        , Text.pack ruleString
+        , "Err:"
+        , Text.pack err
+        ]
+    Right rules -> do
+      Renamer.runRenamerFor mempty rules >>= \case
+        RenamerFail err scope ->
+          pure $ Text.unlines
+            [ "Renaming failed for program:"
+            , Text.pack ruleString
+            , "Because:"
+            , Renamer.renderRenamerError err
+            , "Scope table:"
+            , Text.pack $ pShowNoColorS scope
+            ]
+        RenamerSuccess rnRules _ -> pure $
+          case runExcept (Simala.runTranspiler $ Simala.transpile rnRules) of
+            Left err -> "Failed transpilation:\n" <> Simala.renderTranspilerError err
+            Right simalaDecls -> Simala.render simalaDecls
+  pure $ goldenGeneric outputName result
 
 goldenGeneric :: String -> Text.Text -> Golden Text.Text
 goldenGeneric name output_ =
diff --git a/lib/haskell/natural4/test/Parsing/BoolStructParserSpec.hs b/lib/haskell/natural4/test/Parsing/BoolStructParserSpec.hs
index 0b89f16e7..3ae9f3d4f 100644
--- a/lib/haskell/natural4/test/Parsing/BoolStructParserSpec.hs
+++ b/lib/haskell/natural4/test/Parsing/BoolStructParserSpec.hs
@@ -366,7 +366,9 @@ spec = do
     describe "variable substitution and rule expansion" do
       let parseSM s m = do
             rs <- parseR pToplevel s m
-            return $ getAndOrTree (l4interpret defaultInterpreterOptions rs) 1 (head rs)
+            pure $ do
+              interpreted <- l4interpret defaultInterpreterOptions rs
+              pure $ getAndOrTree interpreted 1 (head rs)
           ab1b2 = Just
             ( Any Nothing
               [ mkLeaf "a"
@@ -378,14 +380,15 @@ spec = do
               ]
             )
 
-      filetest "varsub-1-headhead" "should expand hornlike" parseSM ab1b2
-      filetest "varsub-2-headbody" "should expand hornlike" parseSM ab1b2
-      filetest "varsub-3-bodybody" "should expand hornlike" parseSM ab1b2
-      filetest "varsub-4-bodyhead" "should expand hornlike" parseSM ab1b2
+      filetestIO "varsub-1-headhead" "should expand hornlike" parseSM ab1b2
+      filetestIO "varsub-2-headbody" "should expand hornlike" parseSM ab1b2
+      filetestIO "varsub-3-bodybody" "should expand hornlike" parseSM ab1b2
+      filetestIO "varsub-4-bodyhead" "should expand hornlike" parseSM ab1b2
 
       it "should work when the tree that substitutes has its own label" do
+        interpreted <- l4interpret defaultInterpreterOptions rulesForSubstitutingLabels
         let result = getAndOrTree
-                       (l4interpret defaultInterpreterOptions rulesForSubstitutingLabels)
+                       interpreted
                        1
                        (head rulesForSubstitutingLabels)
         result `shouldBe` substitutedLabelGold
@@ -436,4 +439,4 @@ substitutedLabelGold = Just
                     , mkLeaf "b2" ]
           ]
       ]
-  )
\ No newline at end of file
+  )
diff --git a/lib/haskell/natural4/test/Parsing/CoreL4ParserSpec.hs b/lib/haskell/natural4/test/Parsing/CoreL4ParserSpec.hs
index a440600ce..43ad26048 100644
--- a/lib/haskell/natural4/test/Parsing/CoreL4ParserSpec.hs
+++ b/lib/haskell/natural4/test/Parsing/CoreL4ParserSpec.hs
@@ -14,7 +14,7 @@ import Data.List.NonEmpty (NonEmpty ((:|)))
 import Data.String.Interpolate (i)
 import Data.Text qualified as T
 import LS.BasicTypes (MyStream, MyToken (Decide))
-import LS.Interpreter (classHierarchy, getCTkeys)
+import LS.Interpreter (classHierarchy, getCTkeys, l4interpret)
 import LS.Lib
   ( exampleStreams,
     pRules,
@@ -42,7 +42,7 @@ import LS.Types
     defaultRC,
     extendedAttributes,
     mkLeafR,
-    thisAttributes,
+    thisAttributes, defaultInterpreterOptions, InterpreterOptions (enums2decls),
   )
 import LS.XPile.CoreL4
 import LS.XPile.Logging (fromxpLogE)
@@ -86,7 +86,8 @@ spec  = do
         let testfile = "seca"
         testcsv <- BS.readFile $ "test" </> testfile -<.> "csv"
         let rules  = parseR pRules "" `traverse` exampleStreams testcsv
-        (fmap (fromxpLogE . sfl4ToCorel4) <$> rules) `shouldParse` ["\n#\n# outputted directly from XPile/CoreL4.hs\n#\n\n\n\n-- [SecA_RecoverPassengersVehicleAuthorizedOp]\ndecl s: Situation\n\n--facts\n\nfact <SecA_RecoverPassengersVehicleAuthorizedOp> fromList [([\"s\"],((Just (SimpleType TOne \"Situation\"),[]),[]))]\n\n\n# directToCore\n\n\nrule <SecA_RecoverPassengersVehicleAuthorizedOp>\nfor s: Situation\nif (secA_Applicability && currentSit_s && s == missingKeys)\nthen coverProvided s recoverPassengersVehicleAuthorizedOp SecA_RecoverPassengersVehicleAuthorizedOp\n\n\n"]
+        interpreted <- (traverse . traverse) (l4interpret (defaultInterpreterOptions {enums2decls = True})) rules
+        (fmap (fromxpLogE . sfl4ToCorel4) <$> interpreted) `shouldParse` ["\n#\n# outputted directly from XPile/CoreL4.hs\n#\n\n\n\n-- [SecA_RecoverPassengersVehicleAuthorizedOp]\ndecl s: Situation\n\n--facts\n\nfact <SecA_RecoverPassengersVehicleAuthorizedOp> fromList [([\"s\"],((Just (SimpleType TOne \"Situation\"),[]),[]))]\n\n\n# directToCore\n\n\nrule <SecA_RecoverPassengersVehicleAuthorizedOp>\nfor s: Situation\nif (secA_Applicability && currentSit_s && s == missingKeys)\nthen coverProvided s recoverPassengersVehicleAuthorizedOp SecA_RecoverPassengersVehicleAuthorizedOp\n\n\n"]
 
       filetest "class-1" "type definitions"
         (parseR pRules)
@@ -190,7 +191,7 @@ spec  = do
         (Just ["bar address","firstname","id","lastname","office address","work address"], [])
 
       filetest "class-fa-1" "financial advisor data modelling"
-        (parseR pToplevel) 
+        (parseR pToplevel)
         [ defaultTypeDecl
             { name = [MTT "FinancialStatus"],
               super = Just (InlineEnum TOne ((MTT <$> "adequate" :| ["inadequate"], Nothing) :| [])),

From 82a569454a12d36f58c18f9dd2f72f1d2823a5e5 Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Mon, 19 Aug 2024 17:04:04 +0200
Subject: [PATCH 34/44] Fix hie.yaml file

---
 lib/haskell/hie.yaml | 38 ++++++++++++++++++++++++++++++++++++--
 1 file changed, 36 insertions(+), 2 deletions(-)

diff --git a/lib/haskell/hie.yaml b/lib/haskell/hie.yaml
index 9caecb69d..b98f2901d 100644
--- a/lib/haskell/hie.yaml
+++ b/lib/haskell/hie.yaml
@@ -1,3 +1,37 @@
 cradle:
-  cabal:
-    component: all
+  stack:
+    - path: "anyall/src"
+      component: "anyall:lib"
+
+    - path: "anyall/app/"
+      component: "anyall:exe:anyall-exe"
+
+    - path: "anyall/test"
+      component: "anyall:test:anyall-test"
+
+    - path: "explainable/src"
+      component: "explainable:lib"
+
+    - path: "explainable/app/"
+      component: "explainable:exe:explainable-exe"
+
+    - path: "explainable/test"
+      component: "explainable:test:explainable-test"
+
+    - path: "natural4/src"
+      component: "natural4:lib"
+
+    - path: "natural4/app"
+      component: "natural4:exe:natural4-exe"
+
+    - path: "natural4/test/doctests"
+      component: "natural4:test:doctests"
+
+    - path: "natural4/test"
+      component: "natural4:test:natural4-test"
+
+    - path: "natural4/benchmarks"
+      component: "natural4:bench:natural4-bench"
+
+    - path: "natural4/bnfc"
+      component: "natural4:exe:l4-bnfc-exe"

From 703ae625742a888987ad7501794de03dee82ed57 Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Tue, 20 Aug 2024 11:04:37 +0200
Subject: [PATCH 35/44] Fix doctests

---
 lib/haskell/natural4/src/LS/Renamer.hs | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/lib/haskell/natural4/src/LS/Renamer.hs b/lib/haskell/natural4/src/LS/Renamer.hs
index 557a2cc40..2a7f11684 100644
--- a/lib/haskell/natural4/src/LS/Renamer.hs
+++ b/lib/haskell/natural4/src/LS/Renamer.hs
@@ -69,6 +69,9 @@ module LS.Renamer (
   assertSingletonMultiTerm,
   assertNoTypeSignature,
 
+  -- * Utilities for analyzing the L4 AST
+  toObjectPath,
+
   -- * Debugging helpers
   renameRuleTopLevel,
 ) where
@@ -1230,6 +1233,8 @@ assertEmptyList xs = throwError $ AssertErr $ UnexpectedNonEmptyList (Text.pack
 -- | Given a 'LS.MultiTerm', check whether it has the form of an attribute
 -- selector.
 --
+-- >>> :set -XOverloadedStrings
+--
 -- >>> toObjectPath [LS.MTT "x's", LS.MTT "z"]
 -- Just ("x",["z"])
 --

From 2a49fba55d981cdc17041084cb10edf1343f5659 Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Tue, 20 Aug 2024 15:13:13 +0200
Subject: [PATCH 36/44] Remove unused modules

---
 lib/haskell/natural4/natural4.cabal               | 2 --
 lib/haskell/natural4/src/LS/XPile/Simala/Log.hs   | 1 -
 lib/haskell/natural4/src/LS/XPile/Simala/Types.hs | 2 --
 3 files changed, 5 deletions(-)
 delete mode 100644 lib/haskell/natural4/src/LS/XPile/Simala/Log.hs
 delete mode 100644 lib/haskell/natural4/src/LS/XPile/Simala/Types.hs

diff --git a/lib/haskell/natural4/natural4.cabal b/lib/haskell/natural4/natural4.cabal
index fd5133092..53476e7f0 100644
--- a/lib/haskell/natural4/natural4.cabal
+++ b/lib/haskell/natural4/natural4.cabal
@@ -111,9 +111,7 @@ library
       LS.XPile.Petri
       LS.XPile.Prolog
       LS.XPile.Purescript
-      LS.XPile.Simala.Log
       LS.XPile.Simala.Transpile
-      LS.XPile.Simala.Types
       LS.XPile.SVG
       LS.XPile.Typescript
       LS.XPile.Uppaal
diff --git a/lib/haskell/natural4/src/LS/XPile/Simala/Log.hs b/lib/haskell/natural4/src/LS/XPile/Simala/Log.hs
deleted file mode 100644
index 5a150e98f..000000000
--- a/lib/haskell/natural4/src/LS/XPile/Simala/Log.hs
+++ /dev/null
@@ -1 +0,0 @@
-module LS.XPile.Simala.Log where
diff --git a/lib/haskell/natural4/src/LS/XPile/Simala/Types.hs b/lib/haskell/natural4/src/LS/XPile/Simala/Types.hs
deleted file mode 100644
index 3bf60d362..000000000
--- a/lib/haskell/natural4/src/LS/XPile/Simala/Types.hs
+++ /dev/null
@@ -1,2 +0,0 @@
-module LS.XPile.Simala.Types where
-

From 5d0b368961ac03c8d984c31c4dcd790c83e79112 Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Thu, 22 Aug 2024 11:30:29 +0200
Subject: [PATCH 37/44] Split up the Renamer module into submodules

---
 lib/haskell/natural4/app/Main.hs              |   3 +-
 lib/haskell/natural4/natural4.cabal           |   2 +
 lib/haskell/natural4/src/LS/Interpreter.hs    |   9 +-
 lib/haskell/natural4/src/LS/Renamer.hs        | 820 +++++++-----------
 lib/haskell/natural4/src/LS/Renamer/Rules.hs  | 194 +++++
 lib/haskell/natural4/src/LS/Renamer/Scope.hs  |  91 ++
 .../natural4/src/LS/XPile/Simala/Transpile.hs |   1 +
 7 files changed, 617 insertions(+), 503 deletions(-)
 create mode 100644 lib/haskell/natural4/src/LS/Renamer/Rules.hs
 create mode 100644 lib/haskell/natural4/src/LS/Renamer/Scope.hs

diff --git a/lib/haskell/natural4/app/Main.hs b/lib/haskell/natural4/app/Main.hs
index bb8e66b8b..1f84354f5 100644
--- a/lib/haskell/natural4/app/Main.hs
+++ b/lib/haskell/natural4/app/Main.hs
@@ -125,6 +125,7 @@ import Text.Pretty.Simple (pPrint, pShowNoColor)
 import Text.Regex.PCRE.Heavy qualified as PCRE
 import Text.XML.HXT.Core qualified as HXT
 import qualified LS.Renamer as Renamer
+import LS.Renamer.Rules (RnRule)
 
 --
 -- Command-line options parsing
@@ -658,7 +659,7 @@ withNLGData k ds =
     Nothing  -> pure (Skipped "skipping transpiler due to lacking NLG environment")
     Just env -> k env ds
 
-withRnRules :: ([Renamer.RnRule] -> (TranspilationResult a)) -> DriverState -> (TranspilationResult a)
+withRnRules :: ([RnRule] -> (TranspilationResult a)) -> DriverState -> (TranspilationResult a)
 withRnRules k ds = case ds.interpreted.renamedRules of
   Renamer.RenamerFail errMsg _scope -> Skipped $ "Failed to rename rules: " <> errorToString errMsg
   Renamer.RenamerSuccess rnRules _scope -> k rnRules
diff --git a/lib/haskell/natural4/natural4.cabal b/lib/haskell/natural4/natural4.cabal
index 53476e7f0..c1e0a5832 100644
--- a/lib/haskell/natural4/natural4.cabal
+++ b/lib/haskell/natural4/natural4.cabal
@@ -44,6 +44,8 @@ library
       LS.PrettyPrinter.TypeSig
       LS.RelationalPredicates
       LS.Renamer
+      LS.Renamer.Rules
+      LS.Renamer.Scope
       LS.Rule
       LS.Tokens
       LS.TokenTable
diff --git a/lib/haskell/natural4/src/LS/Interpreter.hs b/lib/haskell/natural4/src/LS/Interpreter.hs
index 93fc8a043..274abf947 100644
--- a/lib/haskell/natural4/src/LS/Interpreter.hs
+++ b/lib/haskell/natural4/src/LS/Interpreter.hs
@@ -112,6 +112,9 @@ import LS.RelationalPredicates
     getBSR,
     partitionExistentials,
   )
+import LS.Renamer.Rules (RnRule)
+import qualified LS.Renamer as Renamer
+import qualified LS.Renamer.Scope as Scope
 import LS.Rule
   ( Rule
       ( DefTypically,
@@ -215,8 +218,6 @@ import LS.XPile.Logging
   )
 import Text.Pretty.Simple (pShowNoColor)
 import Text.Regex.PCRE.Heavy qualified as PCRE
-import qualified LS.Renamer as Renamer
-
 
 -- | This is generated by the Interpreter and handed around to different transpilers.
 --
@@ -243,7 +244,7 @@ data Interpreted = L4I {
   -- eliminated. [TODO].
   , origrules  :: [Rule]
 
-  , renamedRules :: Renamer.RenamerResult [Renamer.RnRule]
+  , renamedRules :: Renamer.RenamerResult [RnRule]
 
   -- | valuepredicates contain the bulk of the top-level decision logic, and can be easily expressed as instance or class methosd.
   , valuePreds :: [ValuePredicate]
@@ -260,7 +261,7 @@ defaultL4I = L4I
   { classtable = CT Map.empty
   , scopetable = Map.empty
   , origrules = mempty
-  , renamedRules = Renamer.RenamerSuccess mempty Renamer.emptyScope
+  , renamedRules = Renamer.RenamerSuccess mempty Scope.emptyScope
   , valuePreds = mempty
   , ruleGraph = Gr.empty
   , ruleGraphErr = mempty
diff --git a/lib/haskell/natural4/src/LS/Renamer.hs b/lib/haskell/natural4/src/LS/Renamer.hs
index 2a7f11684..8d9f67e6f 100644
--- a/lib/haskell/natural4/src/LS/Renamer.hs
+++ b/lib/haskell/natural4/src/LS/Renamer.hs
@@ -11,23 +11,6 @@
 {-# OPTIONS_GHC -Wall #-}
 
 module LS.Renamer (
-  -- * Renamed Rule types
-  RnRule (..),
-  RnHornlike (..),
-  RnTypeDecl (..),
-  RnHornClause (..),
-  RnTypedMulti (..),
-  RnMultiTerm,
-  RnExpr (..),
-  RnName (..),
-  RnNameType (..),
-  RnLit (..),
-  RnRelationalPredicate (..),
-  RnBoolStructR,
-  OccName,
-  Unique,
-  mkSimpleOccName,
-
   -- * Renamer Monad and runners
   RenamerResult (..),
   rnResultScope,
@@ -44,11 +27,7 @@ module LS.Renamer (
   AssertionError (..),
   renderRenamerError,
 
-  -- * Scope checking types
-  Scope (..),
-  emptyScope,
-  scScopeTable,
-  scUniqueSupply,
+  -- * Renamer functions for Scope
   newUnique,
   lookupName,
   lookupExistingName,
@@ -56,13 +35,6 @@ module LS.Renamer (
   insertName,
   insertFunction,
   lookupExistingFunction,
-  ScopeTable (..),
-  stVariables,
-  stFunction,
-  unionScopeTable,
-  differenceScopeTable,
-  emptyScopeTable,
-  FuncInfo (..),
 
   -- * Assertion helpers
   assertEmptyList,
@@ -77,9 +49,8 @@ module LS.Renamer (
 ) where
 
 import AnyAll.BoolStruct qualified as AA
-import LS.Rule (Rule, RuleLabel)
+import LS.Rule (Rule)
 import LS.Rule qualified as Rule
-import LS.Types (MyToken, RuleName, SrcRef)
 import LS.Types qualified as LS
 
 import Control.Monad.Error.Class as Error
@@ -95,7 +66,6 @@ import Data.Functor (void)
 import Data.List qualified as List
 import Data.List.NonEmpty (NonEmpty)
 import Data.List.NonEmpty qualified as NE
-import Data.Map.Strict (Map)
 import Data.Map.Strict qualified as Map
 import Data.Set qualified as Set
 import Data.Text (Text)
@@ -103,218 +73,75 @@ import Data.Text qualified as Text
 import Data.Text.IO qualified as Text
 import Data.Text.Lazy.IO qualified as TL
 import Data.Tuple (Solo (MkSolo))
-import GHC.Generics (Generic)
 import LS.Log (traceWith)
 import LS.Log qualified as Log
 import Optics hiding (has)
 import Prettyprinter
 import Text.Pretty.Simple qualified as Pretty
 
--- ----------------------------------------------------------------------------
--- Types specific to the renamer phase
--- ----------------------------------------------------------------------------
+import LS.Renamer.Rules
+import LS.Renamer.Scope
 
--- | A rename rule is the same as a 'Rule' but names that occur in the rule
--- are resolved and renamed.
--- This aims to provide common ground for transpilers, s.t. a transpiler can
--- assume a name is already defined, and language ambiguities are resolved.
--- Further, this representation aims to be usable for typechecking.
-data RnRule
-  = Hornlike RnHornlike
-  | TypeDecl RnTypeDecl
-  deriving (Eq, Ord, Show, Generic)
+{--
+Renamer Phase:
+~~~~~~~~~~~~~~
 
-type RnBoolStructR = AA.OptionallyLabeledBoolStruct RnRelationalPredicate
+This module implements the 'Renamer' phase of the transformation pipeline from naturalL4 surface syntax
+to one of the many transpilation targets we support.
+The 'Renamer' phase resolves text fragments, or 'MTExpr', to resolved names that can be referred to
+across multiple rules.
 
--- | Corresponds to 'HornClause2', which is equivalent to @HornClause BoolStructR@.
---
--- We don't seem to require any parameterization.
-data RnHornClause = RnHornClause
-  { rnHcHead :: RnRelationalPredicate
-  , rnHcBody :: Maybe RnBoolStructR
-  }
-  deriving (Eq, Ord, Show, Generic)
-
-type RnRuleName = RnMultiTerm
-type RnEntityType = RnName
-
-data RnHornlike = RnHornlike
-  { name :: RnRuleName -- MyInstance
-  , super :: Maybe RnTypeSig -- IS A Superclass
-  , keyword :: MyToken -- decide / define / means
-  , given :: Maybe RnParamText -- a:Applicant, p:Person, l:Lender       -- the type signature of the input
-  , giveth :: Maybe RnParamText -- m:Amount,   mp:Principal, mi:Interest -- the type signature of the output
-  , upon :: Maybe RnParamText -- second request occurs
-  , clauses :: [RnHornClause] -- colour IS blue WHEN fee > $10 ; colour IS green WHEN fee > $20 AND approver IS happy
-  , rlabel :: Maybe RuleLabel
-  , lsource :: Maybe Text
-  , wwhere :: [RnRule]
-  , srcref :: Maybe SrcRef
-  , defaults :: [RnRelationalPredicate] -- SomeConstant IS 500 ; MentalCapacity TYPICALLY True
-  , symtab :: [RnRelationalPredicate] -- SomeConstant IS 500 ; MentalCapacity TYPICALLY True
-  }
-  deriving (Eq, Ord, Show, Generic)
-
-data RnTypeDecl = RnTypeDecl
-  { name :: RnRuleName -- MyInstance
-  , super :: Maybe RnTypeSig -- IS A Superclass
-  , has :: [RnRule] -- HAS foo :: List Hand, bar :: Optional Restaurant
-  , enums :: Maybe RnParamText -- ONE OF rock, paper, scissors (basically, disjoint subtypes)
-  , given :: Maybe RnParamText
-  , upon :: Maybe RnParamText
-  , rlabel :: Maybe RuleLabel
-  , lsource :: Maybe Text.Text
-  , srcref :: Maybe SrcRef
-  , defaults :: [RnRelationalPredicate] -- SomeConstant IS 500 ; MentalCapacity TYPICALLY True
-  , symtab :: [RnRelationalPredicate] -- SomeConstant IS 500 ; MentalCapacity TYPICALLY True
-  }
-  deriving (Eq, Ord, Show, Generic)
+A resolved name is unique across all rules that are renamed in the same 'Renamer' phase. This makes sure that all names that occur
+in renamed rules can be trivially disambiguated, even if their original in-source name was ambiguous.
+Further, a resolved name is tagged with its occurrence name ('OccName') which is the exact fragment of how it appeared in the
+original sources. This can be used for better error messages or easier to understand transpilation results.
+At last, a resolved name is annotated with its "type" or "role", for example, whether it is a function, a record field, or simply a variable.
 
-data RnTypeSig
-  = RnSimpleType LS.ParamType RnEntityType
-  | RnInlineEnum LS.ParamType RnParamText
-  deriving (Eq, Ord, Show, Generic)
+The main entry point of the 'Renamer' phase is 'runRenamerFor', which hides all irrelevant implementation details and renames a collection
+of rules to their renamed corresponding structures.
+This operation may fail for various reasons, for example when a text fragment cannot be resolved because it wasn't defined it.
 
-newtype RnParamText = RnParamText
-  { mkParamText :: NonEmpty RnTypedMulti
-  }
-  deriving (Eq, Ord, Show, Generic)
+Scope Checking:
+~~~~~~~~~~~~~~~
 
-data RnTypedMulti = RnTypedMulti
-  { rnTypedMultiExpr :: NonEmpty RnExpr
-  , rnTypedMultiTypeSig :: Maybe RnTypeSig
-  }
-  deriving (Eq, Ord, Show, Generic)
-
--- | A name is something that can be resolved as either a variable, function, or enum.
-data RnName = RnName
-  { rnOccName :: OccName
-  , rnUniqueId :: Unique
-  , rnNameType :: RnNameType
-  -- TODO: add the binding scope for scope checking
-  -- , rnBindingScope :: BindingScope
-  }
-  deriving (Eq, Ord, Show, Generic)
-
-data RnNameType
-  = RnSelector
-  | RnFunction
-  | RnVariable
-  | RnType
-  | RnEnum
-  | RnBuiltin
-  deriving (Eq, Ord, Show, Generic)
-
-data RnExpr
-  = RnExprName RnName
-  | RnExprLit RnLit
-  deriving (Eq, Ord, Show, Generic)
-
-data RnLit
-  = RnInt Integer
-  | RnDouble Double
-  | RnBool Bool
-  | RnString Text
-  deriving (Eq, Ord, Show, Generic)
-
-type RnMultiTerm = [RnExpr]
-
-data RnRelationalPredicate
-  = -- | Might be something like a record access.
-    RnRelationalTerm RnMultiTerm
-  | RnConstraint RnMultiTerm LS.RPRel RnMultiTerm
-  | RnBoolStructR RnMultiTerm LS.RPRel RnBoolStructR
-  | RnNary LS.RPRel [RnRelationalPredicate]
-  deriving (Eq, Ord, Show, Generic)
+To resolve a text fragment to a resolved name, the 'Renamer' phase implements lexical scope checking.
+This means we separate a rule into blocks of visibility or scopes. Sometimes, we refer to these blocks as clauses.
+For example, a `Hornlike` rule could looks like:
 
--- ----------------------------------------------------------------------------
--- Typed Errors
--- ----------------------------------------------------------------------------
+@
+GIVEN x
+GIVETH y
+DECIDE y IS f x
+WHERE
+  f x IS x+x
+@
 
-data RenamerError
-  = UnsupportedRule Text Rule
-  | UnsupportedRPParamText LS.ParamText
-  | UnsupportedUpon LS.ParamText
-  | UnknownMultiTerms LS.MultiTerm
-  | FixArityFunctionNotFound RnName [RnExpr]
-  | ArityErrorLeft !Int RnName [RnExpr]
-  | ArityErrorRight !Int RnName [RnExpr]
-  | UnexpectedNameNotFound OccName
-  | UnexpectedRnNameNotFound RnName
-  | InsertNameUnexpectedType RnNameType RnNameType
-  | LookupOrInsertNameUnexpectedType RnNameType RnNameType
-  | AssertErr AssertionError
-  deriving (Show, Eq, Ord)
+There are four block here, introduced by `GIVEN`, `GIVETH`, `DECIDE` and `WHERE` respectively.
+The blocks `GIVEN` and `GIVETH` may introduce variables that are used in `DECIDE` or `WHERE` blocks.
+A `WHERE` block may introduce new variables that can be used in the `DECIDE` block or in the same `WHERE` block.
+However, names defined in `DECIDE` can not be used by any other block but are defined in the outer scope of the rule.
+In other words, while `GIVEN`, `GIVETH` and `WHERE` may introduce new names, they are all local to the `DECIDE` clause.
+Names introduced by these blocks may not leak outside of the rule definition.
+However, `DECIDE` blocks define names that can only be used outside of the current rule.
 
--- | Validation Errors
-data AssertionError
-  = -- | List is expected to be empty, but it wasn't!
-    -- The 'Text' parameter is a textual representation of the list that not
-    -- empty! We could use existentials (and we used to), but that makes deriving
-    -- more difficult, so I opted to the simpler solution for now.
-    UnexpectedNonEmptyList Text.Text
-  | -- | List is expected to be singleton list, but it wasn't!
-    -- The 'Text' parameter is a textual representation of the list that not
-    -- empty! We could use existentials (and we used to), but that makes deriving
-    -- more difficult, so I opted to the simpler solution for now.
-    UnexpectedNonSingletonList Text.Text
-  | UnexpectedTypeSignature LS.TypedMulti
-  deriving (Show, Eq, Ord)
+This is what we call "lexical scope checking" in this module.
+Each rule may have a slightly different notion of blocks and lexical scopes.
 
-renderRenamerError :: RenamerError -> Text.Text
-renderRenamerError = \case
-  UnsupportedRule herald r -> herald <> ": Unsupported rule: " <> Text.pack (show r)
-  UnsupportedRPParamText rp -> "Received 'RPParamText', we can't handle that yet. Got: " <> Text.pack (show rp)
-  UnsupportedUpon pText -> "Clause \"UPON\" is currently unsupported: " <> Text.pack (show pText)
-  UnknownMultiTerms mts -> "While scanning a multi term in a top-level DECIDE clause, we encountered an unsupported pattern: " <> Text.pack (show mts)
-  FixArityFunctionNotFound name l ->
-    "Invariant violated, function " <> Text.pack (show name) <> " reported, but not found in " <> Text.pack (show l)
-  ArityErrorLeft expected name l ->
-    "Not enough elements in left hand side of function "
-      <> Text.pack (show name)
-      <> ". Required: "
-      <> Text.pack (show expected)
-      <> " but got: "
-      <> Text.pack (show (length l))
-      <> " ("
-      <> Text.pack (show l)
-      <> ")"
-  ArityErrorRight expected name l ->
-    "Not enough elements in right hand side of function "
-      <> Text.pack (show name)
-      <> ". Required: "
-      <> Text.pack (show expected)
-      <> " but got: "
-      <> Text.pack (show (length l))
-      <> " ("
-      <> Text.pack (show l)
-      <> ")"
-  -- Scope Error
-  UnexpectedNameNotFound occName ->
-    "Assumption violated, OccName not found: " <> Text.pack (show occName)
-  UnexpectedRnNameNotFound rnName ->
-    "Assumption violated, RnName not found: " <> Text.pack (show rnName)
-  InsertNameUnexpectedType expected actual ->
-    "Invariant violated, trying to insert an incorrect RnNameType for a resolved name. Got: "
-      <> Text.pack (show actual)
-      <> " but expected: "
-      <> Text.pack (show expected)
-  LookupOrInsertNameUnexpectedType expected actual ->
-    "Invariant violated, trying to insert or lookup an incorrect RnNameType for a resolved name. Got: "
-      <> Text.pack (show actual)
-      <> " but expected: "
-      <> Text.pack (show expected)
-  AssertErr err -> renderAssertionError err
+--}
 
-renderAssertionError :: AssertionError -> Text.Text
-renderAssertionError = \case
-  -- Validation Errrors
-  UnexpectedNonEmptyList xs ->
-    "Expected an empty list, but got: " <> xs
-  UnexpectedNonSingletonList xs ->
-    "Expected an singleton list, but got: " <> xs
-  UnexpectedTypeSignature tm ->
-    "Expected no type signature, but got: " <> Text.pack (show tm)
+-- ----------------------------------------------------------------------------
+-- Top Level Definitions
+-- ----------------------------------------------------------------------------
+
+-- | Run the renamer phase for a collection of rules.
+--
+-- This operation is solely in the `IO` monad due to the 'Tracer'.
+runRenamerFor :: (Traversable f) => Tracer Log -> f Rule -> IO (RenamerResult (f RnRule))
+runRenamerFor tracer rules = do
+  (resE, scope) <- State.runStateT (Except.runExceptT (runRenamer $ renameRules tracer rules)) emptyScope
+  pure $ case resE of
+    Left err -> RenamerFail err scope
+    Right rnRules -> RenamerSuccess rnRules scope
 
 -- ----------------------------------------------------------------------------
 -- Renamer Main Types.
@@ -337,271 +164,13 @@ data RenamerResult a
   deriving (Show, Eq, Ord)
   deriving (Functor, Traversable, Foldable)
 
-rnResultScope :: RenamerResult a -> Scope
-rnResultScope (RenamerFail _ s) = s
-rnResultScope (RenamerSuccess _ s) = s
-
--- ----------------------------------------------------------------------------
--- Log Messages
--- ----------------------------------------------------------------------------
-
-data Log
-  = LogNewRnName RnName
-  | LogNewFuncInfo RnName FuncInfo
-  | LogScopeTableForRule RuleName ScopeTable
-
-instance Pretty Log where
-  pretty = \case
-    LogNewRnName name ->
-      "Renamed name:"
-        <+> (prettyMultiTerm $ rnOccName name)
-        <+> "with id"
-        <+> pretty (rnUniqueId name)
-        <+> "with type"
-        <+> pretty (rnNameType name)
-    LogNewFuncInfo name funcInfo ->
-      "New Function Information for" <+> prettyMultiTerm (rnOccName name) <> ":" <+> pretty (_funcArity funcInfo)
-    LogScopeTableForRule name sc ->
-      "Renaming Rule with name"
-        <+> prettyMultiTerm name
-        <+> "with"
-        <+> pretty (Pretty.pShow sc)
-
-prettyMultiTerm :: (Traversable f) => f LS.MTExpr -> Doc ann
-prettyMultiTerm = list . Foldable.toList . fmap prettyMT
-
-prettyMT :: LS.MTExpr -> Doc ann
-prettyMT (LS.MTT t) = pretty t
-prettyMT (LS.MTI int) = pretty int
-prettyMT (LS.MTF float) = pretty float
-prettyMT (LS.MTB boolean) = pretty boolean
-
-instance Pretty RnNameType where
-  pretty = \case
-    RnSelector -> "Selector"
-    RnFunction -> "Function"
-    RnVariable -> "Variable"
-    RnType -> "Type"
-    RnEnum -> "Enum"
-    RnBuiltin -> "Builtin"
-
--- ----------------------------------------------------------------------------
--- Scope tables
--- ----------------------------------------------------------------------------
-
-type Unique = Int
-
--- | An unresolved name as it occurs in the original source.
-type OccName = NonEmpty LS.MTExpr
-
-mkSimpleOccName :: Text -> OccName
-mkSimpleOccName = NE.singleton . LS.MTT
-
-data FuncInfo = FuncInfo
-  { _funcArity :: (Int, Int)
-  -- ^ Arity of a function. The first component means how many parameters
-  -- are allowed before the function, the second component how many parameters
-  -- are allowed afterwards.
-  -- For example @(1, 1)@ is a simple infix function of the form @x f y@ where @f@
-  -- is the name of the function.
-  }
-  deriving (Eq, Ord, Show)
-
-data Scope = Scope
-  { _scScopeTable :: ScopeTable
-  , _scUniqueSupply :: Unique
-  -- ^ next unique value that we can use
-  }
-  deriving (Eq, Ord, Show)
-
--- | A 'ScopeTable' keeps tab on the variables and functions that occur in a
--- program.
---
--- Invariant:
---
--- Every name that gets resolved to an 'RnName' with 'RnNameType' being
--- 'RnFunction' should have additional 'FuncInfo' in '_stFunction'.
-data ScopeTable = ScopeTable
-  { _stVariables :: Map OccName RnName
-  -- ^ all names currently in scope
-  , _stFunction :: Map RnName FuncInfo
-  -- ^ additional information for resolved functions
-  }
-  deriving (Eq, Ord, Show)
-
-unionScopeTable :: ScopeTable -> ScopeTable -> ScopeTable
-unionScopeTable tbl1 tbl2 =
-  ScopeTable
-    { _stVariables = Map.union tbl1._stVariables tbl2._stVariables
-    , _stFunction = Map.union tbl1._stFunction tbl2._stFunction
-    }
-
-differenceScopeTable :: ScopeTable -> ScopeTable -> ScopeTable
-differenceScopeTable tbl1 tbl2 =
-  ScopeTable
-    { _stVariables = Map.difference tbl1._stVariables tbl2._stVariables
-    , _stFunction = Map.difference tbl1._stFunction tbl2._stFunction
-    }
-
-emptyScopeTable :: ScopeTable
-emptyScopeTable =
-  ScopeTable
-    { _stVariables = Map.empty
-    , _stFunction = Map.empty
-    }
-
-makeFieldsNoPrefix 'Scope
-makeFieldsNoPrefix 'ScopeTable
-makeFieldsNoPrefix 'FuncInfo
-
-emptyScope :: Scope
-emptyScope =
-  Scope
-    { _scScopeTable = emptyScopeTable
-    , _scUniqueSupply = 0
-    }
-
-newUnique :: Renamer Unique
-newUnique = do
-  u <- use scUniqueSupply
-  modifying' scUniqueSupply (+ 1)
-  pure u
-
--- | Lookup the given name in the 'ScopeTable'.
-lookupName :: OccName -> Renamer (Maybe RnName)
-lookupName occName =
-  use (scScopeTable % stVariables % at occName)
-
--- | Look up the name associated with a given 'OccName' and assert it has
--- the correct 'RnNameType'.
---
--- This can be used when the 'OccName' *must* be present in the 'ScopeTable',
--- otherwise an assumption has been violated.
--- If the name cannot be found, or the name is not of the expected type, we
--- throw an exception.
-lookupExistingName :: OccName -> RnNameType -> Renamer RnName
-lookupExistingName occName nameType = do
-  mRnName <- lookupName occName
-  case mRnName of
-    Nothing -> throwError $ UnexpectedNameNotFound occName
-    Just name
-      | name.rnNameType == nameType -> pure name
-      | otherwise ->
-          throwError $ InsertNameUnexpectedType (rnNameType name) nameType
-
--- | Either inserts a new name of the given type, or checks that the name
--- is already in scope with the given type.
---
--- Fails if the name type does not match.
-lookupOrInsertName :: Tracer Log -> OccName -> RnNameType -> Renamer RnName
-lookupOrInsertName tracer occName nameType =
-  lookupName occName >>= \case
-    Nothing -> insertName tracer occName nameType
-    Just name
-      | rnNameType name == nameType -> pure name
-      | otherwise ->
-          throwError $ LookupOrInsertNameUnexpectedType (rnNameType name) nameType
-
--- | Insert an occurrence name into the current 'ScopeTable'.
--- The new 'OccName' will overwrite (shadow?) any existing names.
-insertName :: Tracer Log -> OccName -> RnNameType -> Renamer RnName
-insertName tracer occName nameType = do
-  n <- newUnique
-  let
-    rnName =
-      RnName
-        { rnUniqueId = n
-        , rnOccName = occName
-        , rnNameType = nameType
-        }
-  traceWith tracer $ LogNewRnName rnName
-  assign'
-    ( scScopeTable
-        % stVariables
-        % at occName
-    )
-    (Just rnName)
-  pure rnName
-
--- | Insert an function meta information into the current 'ScopeTable'.
-insertFunction :: Tracer Log -> RnName -> FuncInfo -> Renamer ()
-insertFunction tracer rnFnName funcInfo = do
-  traceWith tracer $ LogNewFuncInfo rnFnName funcInfo
-  assign'
-    ( scScopeTable
-        % stFunction
-        % at rnFnName
-    )
-    (Just funcInfo)
-
-lookupExistingFunction :: RnName -> Renamer FuncInfo
-lookupExistingFunction rnFnName = do
-  funcInfoM <- use (scScopeTable % stFunction % at rnFnName)
-  case funcInfoM of
-    Nothing -> throwError $ UnexpectedRnNameNotFound rnFnName
-    Just funcInfo -> pure funcInfo
-
--- | Execute a 'Renamer' action, but record which 'RnName's and 'FuncInfo's
--- were introduced during this action.
---
--- Note, this operation is rather expensive, so use it with caution!
-recordScopeTable :: Renamer a -> Renamer (a, ScopeTable)
-recordScopeTable act = do
-  orig <- use scScopeTable
-  a <- act
-  origWithNew <- use scScopeTable
-  pure (a, origWithNew `differenceScopeTable` orig)
-
-recordScopeTable_ :: Renamer a -> Renamer ScopeTable
-recordScopeTable_ = fmap snd . recordScopeTable
-
--- ----------------------------------------------------------------------------
--- Helper types for local context
--- ----------------------------------------------------------------------------
-
--- | Intermediate context when renaming a '[MultiTerm]'.
-data MultiTermContext = MultiTermContext
-  { _multiTermContextInSelector :: Bool
-  -- ^ Did the previous 'MultiTerm' introduce a selector chain?
-  -- A selector chain is introduced, if the multi term has a genitive suffix.
-  -- For example: @[MTT "book's", MTT "title"]@, when @"title"@ is renamed,
-  -- the 'multiTermContextInSelector' is set expected to be to 'True', so that
-  -- we can infer that @"title"@ is a 'RnSelector'.
-  , _multiTermContextFunctionCall :: Maybe RnName
-  -- ^ While renaming a 'MultiTerm', did we encounter a function application?
-  -- If so, we want to fix the call convention from infix/postfix to prefix!
-  }
-
-makeFields 'MultiTermContext
-
-inSelectorContext :: MultiTermContext -> MultiTermContext
-inSelectorContext mtc = mtc & inSelector .~ True
-
-notInSelectorContext :: MultiTermContext -> MultiTermContext
-notInSelectorContext mtc = mtc & inSelector .~ False
-
--- ----------------------------------------------------------------------------
--- Top Level Definitions
--- ----------------------------------------------------------------------------
-
-renameRuleTopLevel :: Rule -> IO ()
-renameRuleTopLevel rule = do
-  TL.putStrLn $ Pretty.pShow rule
-  renamerResult <- runRenamerFor (liftRenamerTracer Log.prettyTracer) (MkSolo rule)
-  TL.putStrLn $ Pretty.pShow $ rnResultScope renamerResult
-  case renamerResult of
-    RenamerFail err _ -> Text.putStrLn $ renderRenamerError err
-    RenamerSuccess (MkSolo rnRules) _ -> TL.putStrLn $ Pretty.pShow rnRules
-
-runRenamerFor :: (Traversable f) => Tracer Log -> f Rule -> IO (RenamerResult (f RnRule))
-runRenamerFor tracer rules = do
-  (resE, scope) <- State.runStateT (Except.runExceptT (runRenamer $ renameRules tracer rules)) emptyScope
-  pure $ case resE of
-    Left err -> RenamerFail err scope
-    Right rnRules -> RenamerSuccess rnRules scope
+rnResultScope :: RenamerResult a -> Scope
+rnResultScope (RenamerFail _ s) = s
+rnResultScope (RenamerSuccess _ s) = s
 
 -- ----------------------------------------------------------------------------
--- Resolve functions and their respective arities
+-- Scan the rule structure and look for names that might influence the renaming
+-- of other rules, such as global variables and function definitions.
 -- ----------------------------------------------------------------------------
 
 -- | Scan the structure of 'Rule' to find declarations that affect other rules.
@@ -689,7 +258,7 @@ scanDecideHeadClause tracer = \case
 -- Additionally, we recognize the following forms:
 --
 -- * @f's x's y's z@: An attribute path from variable @f@ to something that has a @z@ attribute.
--- * @x@: a variable, might be bound ad-hoc
+-- * @x@: a variable, might be bound ad-hoc. In this context, ad-hoc means without prior declaration.
 --
 -- Note, this doesn't accept literals such as '42' or '3.5f' or True or False.
 scanDecideMultiTerm :: Tracer Log -> LS.MultiTerm -> Renamer ()
@@ -830,7 +399,7 @@ scanGivenInlineEnumParamText tracer params = do
 
   traverse_ scanEach params
 
-scanTypeDeclName :: Tracer Log -> RuleName -> Renamer ()
+scanTypeDeclName :: Tracer Log -> LS.RuleName -> Renamer ()
 scanTypeDeclName tracer mtexprs = do
   mt <- assertSingletonMultiTerm mtexprs
   void $ insertName tracer (NE.singleton mt) RnType
@@ -935,7 +504,7 @@ renameRule _ r@Rule.NotARule{} = throwError $ UnsupportedRule "renameRule" r
 renameLocalRules :: Tracer Log -> [Rule] -> Renamer [RnRule]
 renameLocalRules = renameRules
 
-renameTypeDeclName :: RuleName -> Renamer RnRuleName
+renameTypeDeclName :: LS.RuleName -> Renamer RnRuleName
 renameTypeDeclName mtexprs = do
   mt <- assertSingletonMultiTerm mtexprs
   rnTyName <- lookupExistingName (NE.singleton mt) RnType
@@ -1083,7 +652,7 @@ renameMultiTerm tracer multiTerms = do
     rnMultiTerms = reverse reversedRnMultiTerms
   fixFixity ctx rnMultiTerms
  where
-  fixFixity ctx rnMultiTerms = case ctx ^. functionCall of
+  fixFixity ctx rnMultiTerms = case ctx.multiTermContextFunctionCall of
     Nothing -> pure rnMultiTerms
     Just fnName -> do
       funcInfo <- lookupExistingFunction fnName
@@ -1116,8 +685,8 @@ renameMultiTerm tracer multiTerms = do
 
   initialMultiTermContext =
     MultiTermContext
-      { _multiTermContextInSelector = False
-      , _multiTermContextFunctionCall = Nothing
+      { multiTermContextInSelector = False
+      , multiTermContextFunctionCall = Nothing
       }
 
 -- | Rename a single 'LS.MTExpr' to a 'RnExpr'.
@@ -1140,7 +709,7 @@ renameMultiTermExpression tracer ctx = \case
           let
             ctx'' =
               if rnName.rnNameType == RnFunction
-                then ctx' & functionCall ?~ rnName
+                then setMultiTermContextFunctionCall rnName ctx'
                 else ctx'
           pure (RnExprName rnName, ctx'')
         Nothing
@@ -1152,7 +721,7 @@ renameMultiTermExpression tracer ctx = \case
               -- just use a different dedicated constructor for this case.
               rnName <- RnExprName <$> rnL4Builtin tracer name
               pure (rnName, ctx')
-          | ctx ^. inSelector -> do
+          | ctx.multiTermContextInSelector -> do
               rnName <- RnExprName <$> insertName tracer (mkSimpleOccName name) RnSelector
               pure (rnName, ctx')
           | otherwise -> do
@@ -1202,6 +771,248 @@ l4Builtins = [oTHERWISE]
 oTHERWISE :: Text
 oTHERWISE = "OTHERWISE"
 
+-- ----------------------------------------------------------------------------
+-- Typed Errors
+-- ----------------------------------------------------------------------------
+
+data RenamerError
+  = UnsupportedRule Text Rule
+  | UnsupportedRPParamText LS.ParamText
+  | UnsupportedUpon LS.ParamText
+  | UnknownMultiTerms LS.MultiTerm
+  | FixArityFunctionNotFound RnName [RnExpr]
+  | ArityErrorLeft !Int RnName [RnExpr]
+  | ArityErrorRight !Int RnName [RnExpr]
+  | UnexpectedNameNotFound OccName
+  | UnexpectedRnNameNotFound RnName
+  | InsertNameUnexpectedType RnNameType RnNameType
+  | LookupOrInsertNameUnexpectedType RnNameType RnNameType
+  | AssertErr AssertionError
+  deriving (Show, Eq, Ord)
+
+-- | Validation Errors
+data AssertionError
+  = -- | List is expected to be empty, but it wasn't!
+    -- The 'Text' parameter is a textual representation of the list that not
+    -- empty! We could use existentials (and we used to), but that makes deriving
+    -- more difficult, so I opted to the simpler solution for now.
+    UnexpectedNonEmptyList Text.Text
+  | -- | List is expected to be singleton list, but it wasn't!
+    -- The 'Text' parameter is a textual representation of the list that not
+    -- empty! We could use existentials (and we used to), but that makes deriving
+    -- more difficult, so I opted to the simpler solution for now.
+    UnexpectedNonSingletonList Text.Text
+  | UnexpectedTypeSignature LS.TypedMulti
+  deriving (Show, Eq, Ord)
+
+renderRenamerError :: RenamerError -> Text.Text
+renderRenamerError = \case
+  UnsupportedRule herald r -> herald <> ": Unsupported rule: " <> Text.pack (show r)
+  UnsupportedRPParamText rp -> "Received 'RPParamText', we can't handle that yet. Got: " <> Text.pack (show rp)
+  UnsupportedUpon pText -> "Clause \"UPON\" is currently unsupported: " <> Text.pack (show pText)
+  UnknownMultiTerms mts -> "While scanning a multi term in a top-level DECIDE clause, we encountered an unsupported pattern: " <> Text.pack (show mts)
+  FixArityFunctionNotFound name l ->
+    "Invariant violated, function " <> Text.pack (show name) <> " reported, but not found in " <> Text.pack (show l)
+  ArityErrorLeft expected name l ->
+    "Not enough elements in left hand side of function "
+      <> Text.pack (show name)
+      <> ". Required: "
+      <> Text.pack (show expected)
+      <> " but got: "
+      <> Text.pack (show (length l))
+      <> " ("
+      <> Text.pack (show l)
+      <> ")"
+  ArityErrorRight expected name l ->
+    "Not enough elements in right hand side of function "
+      <> Text.pack (show name)
+      <> ". Required: "
+      <> Text.pack (show expected)
+      <> " but got: "
+      <> Text.pack (show (length l))
+      <> " ("
+      <> Text.pack (show l)
+      <> ")"
+  -- Scope Error
+  UnexpectedNameNotFound occName ->
+    "Assumption violated, OccName not found: " <> Text.pack (show occName)
+  UnexpectedRnNameNotFound rnName ->
+    "Assumption violated, RnName not found: " <> Text.pack (show rnName)
+  InsertNameUnexpectedType expected actual ->
+    "Invariant violated, trying to insert an incorrect RnNameType for a resolved name. Got: "
+      <> Text.pack (show actual)
+      <> " but expected: "
+      <> Text.pack (show expected)
+  LookupOrInsertNameUnexpectedType expected actual ->
+    "Invariant violated, trying to insert or lookup an incorrect RnNameType for a resolved name. Got: "
+      <> Text.pack (show actual)
+      <> " but expected: "
+      <> Text.pack (show expected)
+  AssertErr err -> renderAssertionError err
+
+renderAssertionError :: AssertionError -> Text.Text
+renderAssertionError = \case
+  -- Validation Errrors
+  UnexpectedNonEmptyList xs ->
+    "Expected an empty list, but got: " <> xs
+  UnexpectedNonSingletonList xs ->
+    "Expected an singleton list, but got: " <> xs
+  UnexpectedTypeSignature tm ->
+    "Expected no type signature, but got: " <> Text.pack (show tm)
+
+-- ----------------------------------------------------------------------------
+-- Log Messages
+-- ----------------------------------------------------------------------------
+
+data Log
+  = LogNewRnName RnName
+  | LogNewFuncInfo RnName FuncInfo
+  | LogScopeTableForRule LS.RuleName ScopeTable
+
+instance Pretty Log where
+  pretty = \case
+    LogNewRnName name ->
+      "Renamed name:"
+        <+> (prettyMultiTerm $ rnOccName name)
+        <+> "with id"
+        <+> pretty (rnUniqueId name)
+        <+> "with type"
+        <+> pretty (rnNameType name)
+    LogNewFuncInfo name funcInfo ->
+      "New Function Information for" <+> prettyMultiTerm (rnOccName name) <> ":" <+> pretty (_funcArity funcInfo)
+    LogScopeTableForRule name sc ->
+      "Renaming Rule with name"
+        <+> prettyMultiTerm name
+        <+> "with"
+        <+> pretty (Pretty.pShow sc)
+
+prettyMultiTerm :: (Traversable f) => f LS.MTExpr -> Doc ann
+prettyMultiTerm = list . Foldable.toList . fmap prettyMT
+
+-- ----------------------------------------------------------------------------
+-- Scope tables
+-- ----------------------------------------------------------------------------
+
+newUnique :: Renamer Unique
+newUnique = do
+  u <- use scUniqueSupply
+  modifying' scUniqueSupply (+ 1)
+  pure u
+
+-- | Lookup the given name in the 'ScopeTable'.
+lookupName :: OccName -> Renamer (Maybe RnName)
+lookupName occName =
+  use (scScopeTable % stVariables % at occName)
+
+-- | Look up the name associated with a given 'OccName' and assert it has
+-- the correct 'RnNameType'.
+--
+-- This can be used when the 'OccName' *must* be present in the 'ScopeTable',
+-- otherwise an assumption has been violated.
+-- If the name cannot be found, or the name is not of the expected type, we
+-- throw an exception.
+lookupExistingName :: OccName -> RnNameType -> Renamer RnName
+lookupExistingName occName nameType = do
+  mRnName <- lookupName occName
+  case mRnName of
+    Nothing -> throwError $ UnexpectedNameNotFound occName
+    Just name
+      | name.rnNameType == nameType -> pure name
+      | otherwise ->
+          throwError $ InsertNameUnexpectedType (rnNameType name) nameType
+
+-- | Either inserts a new name of the given type, or checks that the name
+-- is already in scope with the given type.
+--
+-- Fails if the name type does not match.
+lookupOrInsertName :: Tracer Log -> OccName -> RnNameType -> Renamer RnName
+lookupOrInsertName tracer occName nameType =
+  lookupName occName >>= \case
+    Nothing -> insertName tracer occName nameType
+    Just name
+      | rnNameType name == nameType -> pure name
+      | otherwise ->
+          throwError $ LookupOrInsertNameUnexpectedType (rnNameType name) nameType
+
+-- | Insert an occurrence name into the current 'ScopeTable'.
+-- The new 'OccName' will overwrite (shadow?) any existing names.
+insertName :: Tracer Log -> OccName -> RnNameType -> Renamer RnName
+insertName tracer occName nameType = do
+  n <- newUnique
+  let
+    rnName =
+      RnName
+        { rnUniqueId = n
+        , rnOccName = occName
+        , rnNameType = nameType
+        }
+  traceWith tracer $ LogNewRnName rnName
+  assign'
+    ( scScopeTable
+        % stVariables
+        % at occName
+    )
+    (Just rnName)
+  pure rnName
+
+-- | Insert an function meta information into the current 'ScopeTable'.
+insertFunction :: Tracer Log -> RnName -> FuncInfo -> Renamer ()
+insertFunction tracer rnFnName funcInfo = do
+  traceWith tracer $ LogNewFuncInfo rnFnName funcInfo
+  assign'
+    ( scScopeTable
+        % stFunction
+        % at rnFnName
+    )
+    (Just funcInfo)
+
+lookupExistingFunction :: RnName -> Renamer FuncInfo
+lookupExistingFunction rnFnName = do
+  funcInfoM <- use (scScopeTable % stFunction % at rnFnName)
+  case funcInfoM of
+    Nothing -> throwError $ UnexpectedRnNameNotFound rnFnName
+    Just funcInfo -> pure funcInfo
+
+-- | Execute a 'Renamer' action, but record which 'RnName's and 'FuncInfo's
+-- were introduced during this action.
+--
+-- Note, this operation is rather expensive, so use it with caution!
+recordScopeTable :: Renamer a -> Renamer (a, ScopeTable)
+recordScopeTable act = do
+  orig <- use scScopeTable
+  a <- act
+  origWithNew <- use scScopeTable
+  pure (a, origWithNew `differenceScopeTable` orig)
+
+recordScopeTable_ :: Renamer a -> Renamer ScopeTable
+recordScopeTable_ = fmap snd . recordScopeTable
+
+-- ----------------------------------------------------------------------------
+-- Helper types for local context
+-- ----------------------------------------------------------------------------
+
+-- | Intermediate context when renaming a '[MultiTerm]'.
+data MultiTermContext = MultiTermContext
+  { multiTermContextInSelector :: Bool
+  -- ^ Did the previous 'MultiTerm' introduce a selector chain?
+  -- A selector chain is introduced, if the multi term has a genitive suffix.
+  -- For example: @[MTT "book's", MTT "title"]@, when @"title"@ is renamed,
+  -- the 'multiTermContextInSelector' is set expected to be to 'True', so that
+  -- we can infer that @"title"@ is a 'RnSelector'.
+  , multiTermContextFunctionCall :: Maybe RnName
+  -- ^ While renaming a 'MultiTerm', did we encounter a function application?
+  -- If so, we want to fix the call convention from infix/postfix to prefix!
+  }
+
+inSelectorContext :: MultiTermContext -> MultiTermContext
+inSelectorContext mtc = mtc{multiTermContextInSelector = True}
+
+notInSelectorContext :: MultiTermContext -> MultiTermContext
+notInSelectorContext mtc = mtc{multiTermContextInSelector = False}
+
+setMultiTermContextFunctionCall :: RnName -> MultiTermContext -> MultiTermContext
+setMultiTermContextFunctionCall name mtc = mtc{multiTermContextFunctionCall = Just name}
+
 -- ----------------------------------------------------------------------------
 -- Assertions and helpers.
 -- These allow us to express expectations and clean up the code
@@ -1293,3 +1104,16 @@ safeSplitAt i as =
   go 0 xs lhs = Just (lhs, xs)
   go _n [] _lhs = Nothing
   go n (x : xs) lhs = go (n - 1) xs (x : lhs)
+
+-- ----------------------------------------------------------------------------
+-- Debugging helper
+-- ----------------------------------------------------------------------------
+
+renameRuleTopLevel :: Rule -> IO ()
+renameRuleTopLevel rule = do
+  TL.putStrLn $ Pretty.pShow rule
+  renamerResult <- runRenamerFor (liftRenamerTracer Log.prettyTracer) (MkSolo rule)
+  TL.putStrLn $ Pretty.pShow $ rnResultScope renamerResult
+  case renamerResult of
+    RenamerFail err _ -> Text.putStrLn $ renderRenamerError err
+    RenamerSuccess (MkSolo rnRules) _ -> TL.putStrLn $ Pretty.pShow rnRules
diff --git a/lib/haskell/natural4/src/LS/Renamer/Rules.hs b/lib/haskell/natural4/src/LS/Renamer/Rules.hs
new file mode 100644
index 000000000..a20f64edb
--- /dev/null
+++ b/lib/haskell/natural4/src/LS/Renamer/Rules.hs
@@ -0,0 +1,194 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wall #-}
+
+module LS.Renamer.Rules (
+  -- * Renamed Rule types
+  RnRule (..),
+  RnHornlike (..),
+  RnTypeDecl (..),
+  RnHornClause (..),
+  RnTypedMulti (..),
+  RnParamText (..),
+  RnRuleName,
+  RnMultiTerm,
+  RnExpr (..),
+  RnName (..),
+  RnNameType (..),
+  RnTypeSig (..),
+  RnEntityType,
+  RnLit (..),
+  RnRelationalPredicate (..),
+  RnBoolStructR,
+  OccName,
+  Unique,
+  mkSimpleOccName,
+
+  -- * Pretty functions for types that do not have a canonical 'Pretty' unique
+  prettyMT,
+) where
+
+import AnyAll.BoolStruct qualified as AA
+import LS.Rule (RuleLabel)
+import LS.Types (MyToken, SrcRef)
+import LS.Types qualified as LS
+
+import Data.List.NonEmpty (NonEmpty)
+import Data.List.NonEmpty qualified as NE
+import Data.Text (Text)
+import Data.Text qualified as Text
+import GHC.Generics (Generic)
+import Prettyprinter
+
+-- ----------------------------------------------------------------------------
+-- Types specific to the renamer phase
+-- ----------------------------------------------------------------------------
+
+-- | A rename rule is the same as a 'Rule' but names that occur in the rule
+-- are resolved and renamed.
+-- This aims to provide common ground for transpilers, s.t. a transpiler can
+-- assume a name is already defined, and language ambiguities are resolved.
+-- Further, this representation aims to be usable for typechecking.
+data RnRule
+  = Hornlike RnHornlike
+  | TypeDecl RnTypeDecl
+  deriving (Eq, Ord, Show, Generic)
+
+type RnBoolStructR = AA.OptionallyLabeledBoolStruct RnRelationalPredicate
+
+-- | Corresponds to 'HornClause2', which is equivalent to @HornClause BoolStructR@.
+--
+-- We don't seem to require any parameterization.
+data RnHornClause = RnHornClause
+  { rnHcHead :: RnRelationalPredicate
+  , rnHcBody :: Maybe RnBoolStructR
+  }
+  deriving (Eq, Ord, Show, Generic)
+
+type RnRuleName = RnMultiTerm
+type RnEntityType = RnName
+
+data RnHornlike = RnHornlike
+  { name :: RnRuleName -- MyInstance
+  , super :: Maybe RnTypeSig -- IS A Superclass
+  , keyword :: MyToken -- decide / define / means
+  , given :: Maybe RnParamText -- a:Applicant, p:Person, l:Lender       -- the type signature of the input
+  , giveth :: Maybe RnParamText -- m:Amount,   mp:Principal, mi:Interest -- the type signature of the output
+  , upon :: Maybe RnParamText -- second request occurs
+  , clauses :: [RnHornClause] -- colour IS blue WHEN fee > $10 ; colour IS green WHEN fee > $20 AND approver IS happy
+  , rlabel :: Maybe RuleLabel
+  , lsource :: Maybe Text
+  , wwhere :: [RnRule]
+  , srcref :: Maybe SrcRef
+  , defaults :: [RnRelationalPredicate] -- SomeConstant IS 500 ; MentalCapacity TYPICALLY True
+  , symtab :: [RnRelationalPredicate] -- SomeConstant IS 500 ; MentalCapacity TYPICALLY True
+  }
+  deriving (Eq, Ord, Show, Generic)
+
+data RnTypeDecl = RnTypeDecl
+  { name :: RnRuleName -- MyInstance
+  , super :: Maybe RnTypeSig -- IS A Superclass
+  , has :: [RnRule] -- HAS foo :: List Hand, bar :: Optional Restaurant
+  , enums :: Maybe RnParamText -- ONE OF rock, paper, scissors (basically, disjoint subtypes)
+  , given :: Maybe RnParamText
+  , upon :: Maybe RnParamText
+  , rlabel :: Maybe RuleLabel
+  , lsource :: Maybe Text.Text
+  , srcref :: Maybe SrcRef
+  , defaults :: [RnRelationalPredicate] -- SomeConstant IS 500 ; MentalCapacity TYPICALLY True
+  , symtab :: [RnRelationalPredicate] -- SomeConstant IS 500 ; MentalCapacity TYPICALLY True
+  }
+  deriving (Eq, Ord, Show, Generic)
+
+data RnTypeSig
+  = RnSimpleType LS.ParamType RnEntityType
+  | RnInlineEnum LS.ParamType RnParamText
+  deriving (Eq, Ord, Show, Generic)
+
+newtype RnParamText = RnParamText
+  { mkParamText :: NonEmpty RnTypedMulti
+  }
+  deriving (Eq, Ord, Show, Generic)
+
+data RnTypedMulti = RnTypedMulti
+  { rnTypedMultiExpr :: NonEmpty RnExpr
+  , rnTypedMultiTypeSig :: Maybe RnTypeSig
+  }
+  deriving (Eq, Ord, Show, Generic)
+
+-- | A name is something that can be resolved as either a variable, function, or enum.
+data RnName = RnName
+  { rnOccName :: OccName
+  , rnUniqueId :: Unique
+  , rnNameType :: RnNameType
+  -- TODO: add the binding scope for scope checking
+  -- , rnBindingScope :: BindingScope
+  }
+  deriving (Eq, Ord, Show, Generic)
+
+data RnNameType
+  = RnSelector
+  | RnFunction
+  | RnVariable
+  | RnType
+  | RnEnum
+  | RnBuiltin
+  deriving (Eq, Ord, Show, Generic)
+
+data RnExpr
+  = RnExprName RnName
+  | RnExprLit RnLit
+  deriving (Eq, Ord, Show, Generic)
+
+data RnLit
+  = RnInt Integer
+  | RnDouble Double
+  | RnBool Bool
+  | RnString Text
+  deriving (Eq, Ord, Show, Generic)
+
+type RnMultiTerm = [RnExpr]
+
+data RnRelationalPredicate
+  = -- | Might be something like a record access.
+    RnRelationalTerm RnMultiTerm
+  | RnConstraint RnMultiTerm LS.RPRel RnMultiTerm
+  | RnBoolStructR RnMultiTerm LS.RPRel RnBoolStructR
+  | RnNary LS.RPRel [RnRelationalPredicate]
+  deriving (Eq, Ord, Show, Generic)
+
+type Unique = Int
+
+-- | An unresolved name as it occurs in the original source.
+type OccName = NonEmpty LS.MTExpr
+
+-- | A simple 'OccName' which contains a single text fragment.
+mkSimpleOccName :: Text -> OccName
+mkSimpleOccName = NE.singleton . LS.MTT
+
+-- ----------------------------------------------------------------------------
+-- Pretty instances
+-- ----------------------------------------------------------------------------
+
+prettyMT :: LS.MTExpr -> Doc ann
+prettyMT (LS.MTT t) = pretty t
+prettyMT (LS.MTI int) = pretty int
+prettyMT (LS.MTF float) = pretty float
+prettyMT (LS.MTB boolean) = pretty boolean
+
+instance Pretty RnNameType where
+  pretty = \case
+    RnSelector -> "Selector"
+    RnFunction -> "Function"
+    RnVariable -> "Variable"
+    RnType -> "Type"
+    RnEnum -> "Enum"
+    RnBuiltin -> "Builtin"
diff --git a/lib/haskell/natural4/src/LS/Renamer/Scope.hs b/lib/haskell/natural4/src/LS/Renamer/Scope.hs
new file mode 100644
index 000000000..b27074b2f
--- /dev/null
+++ b/lib/haskell/natural4/src/LS/Renamer/Scope.hs
@@ -0,0 +1,91 @@
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wall #-}
+
+module LS.Renamer.Scope (
+  -- * Types for implementing the Renamer scope checking
+  Scope (..),
+  emptyScope,
+  scScopeTable,
+  scUniqueSupply,
+  ScopeTable (..),
+  stVariables,
+  stFunction,
+  unionScopeTable,
+  differenceScopeTable,
+  emptyScopeTable,
+  FuncInfo (..),
+  funcArity,
+) where
+
+import Data.Map.Strict (Map)
+import Data.Map.Strict qualified as Map
+import Optics hiding (has)
+
+import LS.Renamer.Rules
+
+data FuncInfo = FuncInfo
+  { _funcArity :: (Int, Int)
+  -- ^ Arity of a function. The first component means how many parameters
+  -- are allowed before the function, the second component how many parameters
+  -- are allowed afterwards.
+  -- For example @(1, 1)@ is a simple infix function of the form @x f y@ where @f@
+  -- is the name of the function.
+  }
+  deriving (Eq, Ord, Show)
+
+data Scope = Scope
+  { _scScopeTable :: ScopeTable
+  , _scUniqueSupply :: Unique
+  -- ^ next unique value that we can use
+  }
+  deriving (Eq, Ord, Show)
+
+-- | A 'ScopeTable' keeps tab on the variables and functions that occur in a
+-- program.
+--
+-- Invariant:
+--
+-- Every name that gets resolved to an 'RnName' with 'RnNameType' being
+-- 'RnFunction' should have additional 'FuncInfo' in '_stFunction'.
+data ScopeTable = ScopeTable
+  { _stVariables :: Map OccName RnName
+  -- ^ all names currently in scope
+  , _stFunction :: Map RnName FuncInfo
+  -- ^ additional information for resolved functions
+  }
+  deriving (Eq, Ord, Show)
+
+unionScopeTable :: ScopeTable -> ScopeTable -> ScopeTable
+unionScopeTable tbl1 tbl2 =
+  ScopeTable
+    { _stVariables = Map.union tbl1._stVariables tbl2._stVariables
+    , _stFunction = Map.union tbl1._stFunction tbl2._stFunction
+    }
+
+differenceScopeTable :: ScopeTable -> ScopeTable -> ScopeTable
+differenceScopeTable tbl1 tbl2 =
+  ScopeTable
+    { _stVariables = Map.difference tbl1._stVariables tbl2._stVariables
+    , _stFunction = Map.difference tbl1._stFunction tbl2._stFunction
+    }
+
+emptyScopeTable :: ScopeTable
+emptyScopeTable =
+  ScopeTable
+    { _stVariables = Map.empty
+    , _stFunction = Map.empty
+    }
+
+makeFieldsNoPrefix 'Scope
+makeFieldsNoPrefix 'ScopeTable
+makeFieldsNoPrefix 'FuncInfo
+
+emptyScope :: Scope
+emptyScope =
+  Scope
+    { _scScopeTable = emptyScopeTable
+    , _scUniqueSupply = 0
+    }
diff --git a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
index 6e75f7831..3a203547f 100644
--- a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
+++ b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
@@ -35,6 +35,7 @@ import LS.Log qualified as Log
 import Simala.Expr.Parser qualified as Simala
 import Simala.Expr.Render qualified as Simala
 import Simala.Expr.Type qualified as Simala
+import LS.Renamer.Rules
 
 -- | A @'SimalaTerm'@ is like a 'Simala.Expr' but in an unsaturated form.
 -- By "unsaturated", we mean that there might be holes in the expression that

From f1efe655e82a64e7a0a95ca8cf5573d54a5d69d4 Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Thu, 22 Aug 2024 12:23:45 +0200
Subject: [PATCH 38/44] Handle builtins separately from variables

---
 lib/haskell/natural4/src/LS/Renamer.hs        | 26 ++--------------
 lib/haskell/natural4/src/LS/Renamer/Rules.hs  | 30 +++++++++++++++++--
 .../natural4/src/LS/XPile/Simala/Transpile.hs |  6 +++-
 .../renamer/decide-with-attributes.expected   | 11 +------
 .../xpile/simala/function-record.expected     |  2 +-
 ...on-with-attributes-conditionals-2.expected |  2 +-
 .../function-with-conditionals-1.expected     |  2 +-
 .../function-with-conditionals-2.expected     |  2 +-
 8 files changed, 40 insertions(+), 41 deletions(-)

diff --git a/lib/haskell/natural4/src/LS/Renamer.hs b/lib/haskell/natural4/src/LS/Renamer.hs
index 8d9f67e6f..3efc5da5e 100644
--- a/lib/haskell/natural4/src/LS/Renamer.hs
+++ b/lib/haskell/natural4/src/LS/Renamer.hs
@@ -67,7 +67,6 @@ import Data.List qualified as List
 import Data.List.NonEmpty (NonEmpty)
 import Data.List.NonEmpty qualified as NE
 import Data.Map.Strict qualified as Map
-import Data.Set qualified as Set
 import Data.Text (Text)
 import Data.Text qualified as Text
 import Data.Text.IO qualified as Text
@@ -715,12 +714,8 @@ renameMultiTermExpression tracer ctx = \case
         Nothing
           | Just literal <- isTextLiteral name ->
               pure (RnExprLit $ RnString literal, ctx')
-          | isL4BuiltIn name -> do
-              -- ANDRES: I'm not convinced that built-ins should be renamed, and
-              -- if we already detected that they're built-ins, perhaps we should
-              -- just use a different dedicated constructor for this case.
-              rnName <- RnExprName <$> rnL4Builtin tracer name
-              pure (rnName, ctx')
+          | Just builtin <- isL4BuiltIn (mkSimpleOccName name) -> do
+              pure (RnExprBuiltin builtin, ctx')
           | ctx.multiTermContextInSelector -> do
               rnName <- RnExprName <$> insertName tracer (mkSimpleOccName name) RnSelector
               pure (rnName, ctx')
@@ -754,23 +749,6 @@ renameMultiTermExpression tracer ctx = \case
     (t'', '"') <- unsnoc t'
     pure t''
 
--- ----------------------------------------------------------------------------
--- Builtins
--- ----------------------------------------------------------------------------
-
-isL4BuiltIn :: Text -> Bool
-isL4BuiltIn name = Set.member name (Set.fromList l4Builtins)
-
-rnL4Builtin :: Tracer Log -> Text -> Renamer RnName
-rnL4Builtin tracer name = do
-  lookupOrInsertName tracer (mkSimpleOccName name) RnBuiltin
-
-l4Builtins :: [Text]
-l4Builtins = [oTHERWISE]
-
-oTHERWISE :: Text
-oTHERWISE = "OTHERWISE"
-
 -- ----------------------------------------------------------------------------
 -- Typed Errors
 -- ----------------------------------------------------------------------------
diff --git a/lib/haskell/natural4/src/LS/Renamer/Rules.hs b/lib/haskell/natural4/src/LS/Renamer/Rules.hs
index a20f64edb..e9e85adee 100644
--- a/lib/haskell/natural4/src/LS/Renamer/Rules.hs
+++ b/lib/haskell/natural4/src/LS/Renamer/Rules.hs
@@ -32,6 +32,11 @@ module LS.Renamer.Rules (
   Unique,
   mkSimpleOccName,
 
+  -- * Builtins
+  RnBuiltin (..),
+  isL4BuiltIn,
+  l4Builtins,
+
   -- * Pretty functions for types that do not have a canonical 'Pretty' unique
   prettyMT,
 ) where
@@ -43,6 +48,8 @@ import LS.Types qualified as LS
 
 import Data.List.NonEmpty (NonEmpty)
 import Data.List.NonEmpty qualified as NE
+import Data.Map.Strict (Map)
+import Data.Map.Strict qualified as Map
 import Data.Text (Text)
 import Data.Text qualified as Text
 import GHC.Generics (Generic)
@@ -140,11 +147,11 @@ data RnNameType
   | RnVariable
   | RnType
   | RnEnum
-  | RnBuiltin
   deriving (Eq, Ord, Show, Generic)
 
 data RnExpr
   = RnExprName RnName
+  | RnExprBuiltin RnBuiltin
   | RnExprLit RnLit
   deriving (Eq, Ord, Show, Generic)
 
@@ -174,6 +181,26 @@ type OccName = NonEmpty LS.MTExpr
 mkSimpleOccName :: Text -> OccName
 mkSimpleOccName = NE.singleton . LS.MTT
 
+-- ----------------------------------------------------------------------------
+-- Builtins
+-- ----------------------------------------------------------------------------
+
+data RnBuiltin
+  = RnOtherwise
+  deriving (Eq, Ord, Show, Generic)
+
+isL4BuiltIn :: OccName -> Maybe RnBuiltin
+isL4BuiltIn name = Map.lookup name l4Builtins
+
+l4Builtins :: Map OccName RnBuiltin
+l4Builtins =
+  Map.fromList
+    [ (oTHERWISE, RnOtherwise)
+    ]
+
+oTHERWISE :: OccName
+oTHERWISE = mkSimpleOccName "OTHERWISE"
+
 -- ----------------------------------------------------------------------------
 -- Pretty instances
 -- ----------------------------------------------------------------------------
@@ -191,4 +218,3 @@ instance Pretty RnNameType where
     RnVariable -> "Variable"
     RnType -> "Type"
     RnEnum -> "Enum"
-    RnBuiltin -> "Builtin"
diff --git a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
index 3a203547f..833811f69 100644
--- a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
+++ b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
@@ -585,6 +585,7 @@ isProjection mtHead args = do
 
 exprToSimala :: RnExpr -> Simala.Expr
 exprToSimala (RnExprName name) = Simala.Var $ toSimalaName name
+exprToSimala (RnExprBuiltin builtin) = builtinToSimala builtin
 exprToSimala (RnExprLit lit) = litToSimala lit
 
 litToSimala :: RnLit -> Simala.Expr
@@ -607,6 +608,7 @@ isExprOfType :: RnExpr -> (RnNameType -> Bool) -> Maybe RnName
 isExprOfType (RnExprName name) hasTy
   | hasTy name.rnNameType = Just name
   | otherwise = Nothing
+isExprOfType (RnExprBuiltin _) _ = Nothing
 isExprOfType (RnExprLit _) _ = Nothing
 
 -- ----------------------------------------------------------------------------
@@ -636,7 +638,9 @@ rnNameTypePrefix = \case
   RnVariable -> "v"
   RnType -> "t"
   RnEnum -> "e"
-  RnBuiltin -> "b"
+
+builtinToSimala :: RnBuiltin -> Simala.Expr
+builtinToSimala RnOtherwise = Simala.Var "otherwise"
 
 -- ----------------------------------------------------------------------------
 -- Assertion helpers
diff --git a/lib/haskell/natural4/test/testdata/golden/renamer/decide-with-attributes.expected b/lib/haskell/natural4/test/testdata/golden/renamer/decide-with-attributes.expected
index da083fab3..d6947a6ff 100644
--- a/lib/haskell/natural4/test/testdata/golden/renamer/decide-with-attributes.expected
+++ b/lib/haskell/natural4/test/testdata/golden/renamer/decide-with-attributes.expected
@@ -150,16 +150,7 @@ Right
                                     ]
                                 , rnHcBody = Just
                                     ( Leaf
-                                        ( RnRelationalTerm
-                                            [ RnExprName
-                                                ( RnName
-                                                    { rnOccName = MTT "OTHERWISE" :| []
-                                                    , rnUniqueId = 4
-                                                    , rnNameType = RnBuiltin
-                                                    }
-                                                )
-                                            ]
-                                        )
+                                        ( RnRelationalTerm [ RnExprBuiltin RnOtherwise ] )
                                     )
                                 }
                             ]
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-record.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-record.expected
index 64663ee85..58a62e278 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-record.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-record.expected
@@ -1 +1 @@
- f_g_1 = fun (v_d_0) => let v_y_2 = {s_book_3 = if v_d_0 > 0 then 'green else if b_OTHERWISE_4 then 'red else undefined} in v_y_2
+ f_g_1 = fun (v_d_0) => let v_y_2 = {s_book_3 = if v_d_0 > 0 then 'green else if otherwise then 'red else undefined} in v_y_2
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-conditionals-2.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-conditionals-2.expected
index deb4adfef..a3a1a185d 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-conditionals-2.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-attributes-conditionals-2.expected
@@ -1 +1 @@
- f_f_1 = fun (v_x_0) => let v_y_2 = {s_p_4 = if v_x_0 > 5 then v_x_0 else if b_OTHERWISE_5 then v_x_0 + v_x_0 else undefined,s_z_3 = if v_x_0 > 3 then 5 else if b_OTHERWISE_5 then 0 else undefined} in v_y_2
+ f_f_1 = fun (v_x_0) => let v_y_2 = {s_p_4 = if v_x_0 > 5 then v_x_0 else if otherwise then v_x_0 + v_x_0 else undefined,s_z_3 = if v_x_0 > 3 then 5 else if otherwise then 0 else undefined} in v_y_2
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-1.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-1.expected
index ff2657cea..66400da76 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-1.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-1.expected
@@ -1 +1 @@
- f_f_1 = fun (v_x_0) => if v_x_0 > 0 then 1 else if b_OTHERWISE_2 then 0 else if v_x_0 < 0 then 2 else undefined
+ f_f_1 = fun (v_x_0) => if v_x_0 > 0 then 1 else if otherwise then 0 else if v_x_0 < 0 then 2 else undefined
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-2.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-2.expected
index 610e4c2d2..1bec0387e 100644
--- a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-2.expected
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-conditionals-2.expected
@@ -1 +1 @@
- f_f_1 = fun (v_x_0) => if v_x_0 > 0 then 1 else if b_OTHERWISE_2 then 0 else undefined
+ f_f_1 = fun (v_x_0) => if v_x_0 > 0 then 1 else if otherwise then 0 else undefined

From 0c59ebde74190b960e7e3ed2c61d81f7355434f9 Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Thu, 22 Aug 2024 15:15:37 +0200
Subject: [PATCH 39/44] Support more naturalL4 and honour name shadowing

After adding a test case, I realised the name shadowing did not work as
anticipated. We fix this now, move some code around and extend the
transpiler to work correctly for many more naturalL4 constructs and
fragments.
---
 lib/haskell/natural4/src/LS/Renamer.hs        |   8 +-
 lib/haskell/natural4/src/LS/Renamer/Scope.hs  |   4 +-
 .../natural4/src/LS/XPile/Simala/Transpile.hs | 360 +++++++++---------
 lib/haskell/natural4/test/LS/RenamerSpec.hs   |  19 +
 .../natural4/test/LS/XPile/SimalaSpec.hs      |  30 ++
 ...h-name-shadowing-with-where-rules.expected | 308 +++++++++++++++
 .../function-with-name-shadowing.expected     | 172 +++++++++
 ...name-shadowing-with-where-rules-1.expected |   1 +
 ...name-shadowing-with-where-rules-2.expected |   1 +
 .../function-with-name-shadowing.expected     |   1 +
 10 files changed, 724 insertions(+), 180 deletions(-)
 create mode 100644 lib/haskell/natural4/test/testdata/golden/renamer/function-with-name-shadowing-with-where-rules.expected
 create mode 100644 lib/haskell/natural4/test/testdata/golden/renamer/function-with-name-shadowing.expected
 create mode 100644 lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-name-shadowing-with-where-rules-1.expected
 create mode 100644 lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-name-shadowing-with-where-rules-2.expected
 create mode 100644 lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-name-shadowing.expected

diff --git a/lib/haskell/natural4/src/LS/Renamer.hs b/lib/haskell/natural4/src/LS/Renamer.hs
index 3efc5da5e..5b6350f0e 100644
--- a/lib/haskell/natural4/src/LS/Renamer.hs
+++ b/lib/haskell/natural4/src/LS/Renamer.hs
@@ -410,9 +410,11 @@ scanTypeDeclName tracer mtexprs = do
 -- |
 -- Lexical Scoping rules for hornlike rules:
 --
--- GIVETH's are global
--- GIVEN's are local
--- DECIDE head term in "IS" clauses is global
+-- * GIVENs are local to the rule
+-- * A GIVETH can be referred to in other rules up the scope hierarchy
+-- * The head in DECIDE clauses can also be referred to by other rules in scope hierarchy
+-- * WHERE clauses are local to the rule
+--
 renameRules :: (Traversable f) => Tracer Log -> f Rule -> Renamer (f RnRule)
 renameRules tracer rules = do
   rulesWithLocalDefs <-
diff --git a/lib/haskell/natural4/src/LS/Renamer/Scope.hs b/lib/haskell/natural4/src/LS/Renamer/Scope.hs
index b27074b2f..51ffea3fa 100644
--- a/lib/haskell/natural4/src/LS/Renamer/Scope.hs
+++ b/lib/haskell/natural4/src/LS/Renamer/Scope.hs
@@ -61,8 +61,8 @@ data ScopeTable = ScopeTable
 unionScopeTable :: ScopeTable -> ScopeTable -> ScopeTable
 unionScopeTable tbl1 tbl2 =
   ScopeTable
-    { _stVariables = Map.union tbl1._stVariables tbl2._stVariables
-    , _stFunction = Map.union tbl1._stFunction tbl2._stFunction
+    { _stVariables = Map.union tbl2._stVariables tbl1._stVariables
+    , _stFunction = Map.union tbl2._stFunction tbl1._stFunction
     }
 
 differenceScopeTable :: ScopeTable -> ScopeTable -> ScopeTable
diff --git a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
index 833811f69..9d0be0855 100644
--- a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
+++ b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
@@ -6,7 +6,28 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# OPTIONS_GHC -Wall #-}
 
-module LS.XPile.Simala.Transpile where
+module LS.XPile.Simala.Transpile (
+  -- * Main entry point to the transpiler
+  transpile,
+
+  -- * Transpiler monad
+  Transpiler (..),
+  runSimalaTranspiler,
+
+  -- * Utilities to work with simala terms in naturalL4
+  render,
+
+  -- * Internal types that sometimes may be helpful
+  SimalaTerm (..),
+
+  -- * Typed errors and renderers
+  TranspilerError (..),
+  AssertionError (..),
+  renderTranspilerError,
+
+  -- * Debugging utilities
+  debugTranspileRule,
+) where
 
 import Control.Monad.Error.Class (MonadError (..))
 import Control.Monad.Trans.Except
@@ -32,10 +53,30 @@ import TextuaL4.Transform qualified as Parser
 import AnyAll.BoolStruct qualified as AA
 
 import LS.Log qualified as Log
+import LS.Renamer.Rules
 import Simala.Expr.Parser qualified as Simala
 import Simala.Expr.Render qualified as Simala
 import Simala.Expr.Type qualified as Simala
-import LS.Renamer.Rules
+
+-- ----------------------------------------------------------------------------
+-- Top Level transpilation functions and test helpers
+-- ----------------------------------------------------------------------------
+
+newtype Transpiler a = Transpiler {runTranspiler :: Except TranspilerError a}
+  deriving newtype (Functor, Applicative, Monad)
+  deriving newtype (MonadError TranspilerError)
+
+runSimalaTranspiler :: [RnRule] -> Either TranspilerError [Simala.Decl]
+runSimalaTranspiler = runExcept . runTranspiler . transpile
+
+transpile :: [RnRule] -> Transpiler [Simala.Decl]
+transpile rules = do
+  simalaTerms <- Maybe.catMaybes <$> traverse ruleToSimala rules
+  traverse toSimalaDecl simalaTerms
+
+-- ----------------------------------------------------------------------------
+-- Transpiler specific intermediate representations (called IR)
+-- ----------------------------------------------------------------------------
 
 -- | A @'SimalaTerm'@ is like a 'Simala.Expr' but in an unsaturated form.
 -- By "unsaturated", we mean that there might be holes in the expression that
@@ -101,125 +142,6 @@ data SimalaTerm
     TermExpr Simala.Expr
   deriving (Show)
 
--- ----------------------------------------------------------------------------
--- Typed Error
--- ----------------------------------------------------------------------------
-
-data TranspilerError
-  = TermToDeclUnsupported SimalaTerm
-  | UnsupportedLocalTerm Text SimalaTerm
-  | UnsupportedMultiTerm RnMultiTerm
-  | UnsupportedEmptyMultiTerm
-  | ImpossibleLeftSide SimalaTerm
-  | UnsupportedLeftSide RnMultiTerm
-  | UnsupportedRightSide RnMultiTerm
-  | NotImplemented Text
-  | UnsupportedPredicate LS.RPRel
-  | FailedToCombineTerms SimalaTerm SimalaTerm
-  | AssertErr AssertionError
-
-data ExpectedSize
-  = SizeExact !Int
-  | SizeAtLeast !Int
-
-data AssertionError
-  = forall a. (Show a) => UnexpectedNonEmptyList [a]
-  | NotTermAttribute SimalaTerm
-  | NotSingletonList Text !Int
-  | NotTermExpr SimalaTerm
-  | NotMultiTerm Text RnRelationalPredicate
-  | NotRecord Simala.Expr
-  | NotSelectorChain SimalaTerm
-  | forall a. (Show a) => NotEquals a a
-  | UnexpectedEmptyList
-  | UnexpectedListSize ExpectedSize !Int
-
-throwAssertion :: AssertionError -> Transpiler a
-throwAssertion = throwError . AssertErr
-
-renderTranspilerError :: TranspilerError -> Text
-renderTranspilerError = \case
-  TermToDeclUnsupported term ->
-    "Cannot convert SimalaTerm to Decl: " <> tshow term
-  UnsupportedLocalTerm herald term ->
-    herald <> ": Unexpected local term: " <> tshow term
-  UnsupportedMultiTerm multiTerm ->
-    "Unsupported RnMultiTerms: " <> tshow multiTerm
-  UnsupportedEmptyMultiTerm ->
-    "Unexpected empty list of RnMultiTerms"
-  ImpossibleLeftSide term ->
-    "The following SimalaTerm cannot occur on the left hand side of an assignment: " <> tshow term
-  UnsupportedLeftSide multiTerm ->
-    "Unsupported on the left side of an assignment: " <> tshow multiTerm
-  UnsupportedRightSide multiTerm ->
-    "Unsupported on the right side of an assignment: " <> tshow multiTerm
-  NotImplemented herald ->
-    herald <> ": unsupported"
-  UnsupportedPredicate relPred ->
-    "Unsupported RelationalPredicate: " <> tshow relPred
-  FailedToCombineTerms term1 term2 ->
-    "Can't wrap terms in an if-then-else.\nFirst term: "
-      <> tshow term1
-      <> "\nSecond term: "
-      <> tshow term2
-  AssertErr assertionErr -> case assertionErr of
-    UnexpectedNonEmptyList list ->
-      "Expected empty list, but got: " <> tshow list
-    NotTermAttribute term ->
-      "Expected TermAttribute, but got: " <> tshow term
-    NotSingletonList herald size ->
-      herald <> ": Expected singleton list, but got: " <> tshow size
-    NotTermExpr term ->
-      "Expected TermAttribute, but got: " <> tshow term
-    NotMultiTerm herald rnPred ->
-      herald <> ": Expected MultiTerm, but got: " <> tshow rnPred
-    NotRecord expr ->
-      "Expected Record, but got: " <> tshow expr
-    NotSelectorChain term ->
-      "Expected TermAttribute with non-empty selectors, but got: " <> tshow term
-    NotEquals a b ->
-      "Not equal: " <> tshow a <> ", " <> tshow b
-    UnexpectedEmptyList ->
-      "Expected non-empty list"
-    UnexpectedListSize len n ->
-      "Expected list of "
-        <> ( case len of
-              SizeExact i -> "size " <> tshow i
-              SizeAtLeast i -> "at least size " <> tshow i
-           )
-        <> ", but got "
-        <> tshow n
-
-tshow :: (Show a) => a -> Text
-tshow = Text.pack . show
-
--- ----------------------------------------------------------------------------
--- Top Level transpilation functions and test helpers
--- ----------------------------------------------------------------------------
-
-newtype Transpiler a = Transpiler {runTranspiler :: Except TranspilerError a}
-  deriving newtype (Functor, Applicative, Monad)
-  deriving newtype (MonadError TranspilerError)
-
-runSimalaTranspiler :: [RnRule] -> Either TranspilerError [Simala.Decl]
-runSimalaTranspiler = runExcept . runTranspiler . transpile
-
-transpile :: [RnRule] -> Transpiler [Simala.Decl]
-transpile rules = do
-  simalaTerms <- Maybe.catMaybes <$> traverse ruleToSimala rules
-  traverse toSimalaDecl simalaTerms
-
-toSimalaDecl :: SimalaTerm -> Transpiler Simala.Decl
-toSimalaDecl (TermLetIn t name expr) = do
-  pure $ Simala.NonRec t name expr
-toSimalaDecl (TermFunction t name params expr) = do
-  pure $ Simala.NonRec t name $ mkFunctionDecl t params expr
-toSimalaDecl term = do
-  throwError $ TermToDeclUnsupported term
-
-render :: [Simala.Decl] -> Text
-render = Text.unlines . fmap Simala.render
-
 -- ----------------------------------------------------------------------------
 -- Main translation helpers
 -- ----------------------------------------------------------------------------
@@ -239,6 +161,17 @@ ruleToSimala (Hornlike hornlike) = do
   localDefinitions <- traverse ruleToSimala hornlike.wwhere
   Just <$> addLocalDefinitions mainDefinition (Maybe.catMaybes localDefinitions)
 
+toSimalaDecl :: SimalaTerm -> Transpiler Simala.Decl
+toSimalaDecl (TermLetIn t name expr) = do
+  pure $ Simala.NonRec t name expr
+toSimalaDecl (TermFunction t name params expr) = do
+  pure $ Simala.NonRec t name $ mkFunctionDecl t params expr
+toSimalaDecl term = do
+  throwError $ TermToDeclUnsupported term
+
+render :: [Simala.Decl] -> Text
+render = Text.unlines . fmap Simala.render
+
 -- ----------------------------------------------------------------------------
 -- Post Processing of rule translation.
 -- These steps include:
@@ -419,7 +352,7 @@ mergeAttributes name terms = do
 toIfThenElseChain :: NonEmpty (Simala.Expr, Maybe Simala.Expr) -> Simala.Expr
 toIfThenElseChain ((expr, Nothing) :| []) = expr
 toIfThenElseChain ((expr, Just guard) :| []) =
-  Simala.Builtin Simala.IfThenElse [guard, expr, Simala.Undefined]
+  Simala.mkIfThenElse guard expr Simala.Undefined
 toIfThenElseChain ((expr, guard) :| terms) =
   let
     elseExpr = case terms of
@@ -427,7 +360,7 @@ toIfThenElseChain ((expr, guard) :| terms) =
   in
     case guard of
       Nothing -> expr
-      Just g -> Simala.Builtin Simala.IfThenElse [g, expr, elseExpr]
+      Just g -> Simala.mkIfThenElse g expr elseExpr
 
 -- ----------------------------------------------------------------------------
 -- Transpilation
@@ -441,14 +374,14 @@ relationalPredicateToSimala = \case
       | Just (fnName, fnParams) <- isFunctionDeclaration mtHead args -> do
           rhsExpr <- rhsMultiTermToSimala rhs
           mkFunctionTerm (toSimalaName fnName) (fmap toSimalaName fnParams) (TermExpr rhsExpr)
-      | Just (var, selectors) <- isAssignment mtHead args -> do
+      | Just (var, selectors) <- isVariableOrProjection mtHead args -> do
           rhsExpr <- rhsMultiTermToSimala rhs
           mkAssignmentTerm (toSimalaName var) (fmap toSimalaName selectors) rhsExpr
       | otherwise -> throwError $ UnsupportedMultiTerm lhs
     [] -> throwError UnsupportedEmptyMultiTerm
   RnConstraint lhs predicate rhs -> do
     lhsSimalaExpr' <- lhsMultiTermToSimala lhs
-    lhsSimalaExpr <- assertTermExpr lhsSimalaExpr'
+    lhsSimalaExpr <- toSimalaExpression lhsSimalaExpr'
     rhsSimalaExpr <- rhsMultiTermToSimala rhs
     predRelToBuiltIn predicate [lhsSimalaExpr, rhsSimalaExpr]
   RnNary LS.RPis (lhs : rhs) -> do
@@ -458,29 +391,28 @@ relationalPredicateToSimala = \case
     case lhsSimalaTerm of
       TermApp fnName fnParams -> do
         fnExpr <- assertSingletonList "RnNary.TermApp" rhsExprs
-        rhsExpr <- assertTermExpr fnExpr
+        rhsExpr <- toSimalaExpression fnExpr
         mkFunctionTerm fnName fnParams (TermExpr rhsExpr)
       TermLetIn{} -> throwError $ ImpossibleLeftSide lhsSimalaTerm
       TermAttribute name selectors Simala.Undefined -> do
         someRhs <- assertSingletonList "RnNary.TermAttribute" rhsExprs
-        rhsExpr <- assertTermExpr someRhs
+        rhsExpr <- toSimalaExpression someRhs
         pure $ TermAttribute name selectors rhsExpr
       TermAttribute{} -> throwError $ ImpossibleLeftSide lhsSimalaTerm
       TermFunction{} -> throwError $ NotImplemented "RpNary RPis TermFunction"
       TermExpr{} -> throwError $ ImpossibleLeftSide lhsSimalaTerm
-  -- TODO: this is wrong, what about Var and Project?
   RnNary predicate mt ->
     predicateToSimala predicate mt
   RnBoolStructR lhs predicate rhs -> do
     lhsTerm <- lhsMultiTermToSimala lhs
-    lhsExpr <- assertTermExpr lhsTerm
+    lhsExpr <- toSimalaExpression lhsTerm
     rhsSimalaExpr <- boolStructToSimala rhs
     predRelToBuiltIn predicate [lhsExpr, rhsSimalaExpr]
 
 predicateToSimala :: LS.RPRel -> [RnRelationalPredicate] -> Transpiler SimalaTerm
 predicateToSimala rp params' = do
   params <- traverse relationalPredicateToSimala params'
-  exprs <- traverse assertTermExpr params
+  exprs <- traverse toSimalaExpression params
   predRelToBuiltIn rp exprs
 
 predRelToBuiltIn :: LS.RPRel -> [Simala.Expr] -> Transpiler SimalaTerm
@@ -523,45 +455,50 @@ fixedArity b arity params' = do
   pure $ TermExpr $ Simala.Builtin b params
 
 lhsMultiTermToSimala :: RnMultiTerm -> Transpiler SimalaTerm
-lhsMultiTermToSimala [rnExpr] = pure $ TermExpr $ exprToSimala rnExpr
+lhsMultiTermToSimala [rnExpr] = case rnExpr of
+  RnExprName name -> mkVariableTerm (toSimalaName name) Simala.Undefined
+  RnExprBuiltin builtin -> pure $ TermExpr $ builtinToSimala builtin
+  RnExprLit lit -> pure $ TermExpr $ litToSimala lit
 lhsMultiTermToSimala (mtHead : rest)
   | Just (fnName, fnParams) <- isFunctionDeclaration mtHead rest =
       mkFunctionHead (toSimalaName fnName) (fmap toSimalaName fnParams)
-  | Just (varName, selectors) <- isProjection mtHead rest =
-      mkRecordAssignmentTerm (toSimalaName varName) (fmap toSimalaName selectors)
+  | Just (varName, selectors) <- isVariableOrProjection mtHead rest =
+      mkAssignmentTerm (toSimalaName varName) (fmap toSimalaName selectors) Simala.Undefined
 lhsMultiTermToSimala exprs = throwError $ UnsupportedLeftSide exprs
 
 rhsMultiTermToSimala :: RnMultiTerm -> Transpiler Simala.Expr
 rhsMultiTermToSimala [rnExpr] = pure $ exprToSimala rnExpr
 rhsMultiTermToSimala (mtHead : rest)
   | Just _fnName <- isFunction mtHead = pure $ Simala.App (exprToSimala mtHead) $ fmap exprToSimala rest
-  | Just (varName, selectors) <- isProjection mtHead rest = pure $ applySelectors (toSimalaName varName) (fmap toSimalaName selectors)
+  | Just (varName, selectors) <- isVariableOrProjection mtHead rest = case selectors of
+      [] -> pure $ Simala.Var $ toSimalaName varName
+      (sel : ssel) -> pure $ applySelectors (toSimalaName varName) (fmap toSimalaName (sel :| ssel))
 rhsMultiTermToSimala exprs = throwError $ UnsupportedRightSide exprs
 
 boolStructToSimala :: RnBoolStructR -> Transpiler Simala.Expr
 boolStructToSimala = \case
   AA.Leaf relationalPredicate -> do
     simalaTerm <- relationalPredicateToSimala relationalPredicate
-    assertTermExpr simalaTerm
+    toSimalaExpression simalaTerm
   AA.Any _lbl structs -> do
     simalaExprs <- traverse boolStructToSimala structs
     simalaAny <- flexibleArity Simala.Or simalaExprs
-    assertTermExpr simalaAny
+    toSimalaExpression simalaAny
   AA.All _lbl structs -> do
     simalaExprs <- traverse boolStructToSimala structs
     simalaAll <- flexibleArity Simala.And simalaExprs
-    assertTermExpr simalaAll
+    toSimalaExpression simalaAll
   AA.Not struct -> do
     simalaExpr <- boolStructToSimala struct
     simalaNot <- fixedArity Simala.Not 1 [simalaExpr]
-    assertTermExpr simalaNot
+    toSimalaExpression simalaNot
 
 -- ----------------------------------------------------------------------------
 -- Rule pattern recognition
 -- ----------------------------------------------------------------------------
 
-isAssignment :: RnExpr -> [RnExpr] -> Maybe (RnName, [RnName])
-isAssignment name selectors = do
+isVariableOrProjection :: RnExpr -> [RnExpr] -> Maybe (RnName, [RnName])
+isVariableOrProjection name selectors = do
   rnName <- isVariable name
   rnSelectors <- traverse isSelector selectors
   pure (rnName, rnSelectors)
@@ -572,13 +509,6 @@ isFunctionDeclaration mtHead args = do
   argNames <- traverse isVariable args
   pure (fnName, argNames)
 
-isProjection :: RnExpr -> [RnExpr] -> Maybe (RnName, NE.NonEmpty RnName)
-isProjection mtHead args = do
-  varName <- isVariable mtHead
-  nonEmptyRest <- NE.nonEmpty args
-  selectors <- traverse isSelector nonEmptyRest
-  pure (varName, selectors)
-
 -- ----------------------------------------------------------------------------
 -- Renamed Names utilities
 -- ----------------------------------------------------------------------------
@@ -684,11 +614,6 @@ assertPredicateIsMultiTerm _errMsg (RnRelationalTerm mt) = pure mt
 assertPredicateIsMultiTerm errMsg predicate =
   throwAssertion $ NotMultiTerm errMsg predicate
 
-assertTermExpr :: SimalaTerm -> Transpiler Simala.Expr
-assertTermExpr (TermExpr expr) = pure expr
-assertTermExpr term =
-  throwAssertion $ NotTermExpr term
-
 assertEquals :: (Eq a, Show a) => a -> a -> Transpiler ()
 assertEquals a b
   | a == b = pure ()
@@ -699,13 +624,6 @@ assertIsRecord :: Simala.Expr -> Transpiler (Simala.Row Simala.Expr)
 assertIsRecord (Simala.Record row) = pure row
 assertIsRecord simalaExpr = throwAssertion $ NotRecord simalaExpr
 
-assertAttributeHasSelectors :: SimalaTerm -> Transpiler (NonEmpty Simala.Name, Simala.Expr)
-assertAttributeHasSelectors (TermAttribute _ (x : xs) expr) = pure (x :| xs, expr)
-assertAttributeHasSelectors expr@(TermAttribute _ [] _) =
-  throwAssertion $ NotSelectorChain expr
-assertAttributeHasSelectors expr =
-  throwAssertion $ NotTermAttribute expr
-
 -- | If we can't handle transpiling certain list of things, we just hope that
 -- the parser doesn't give us a list with any elements.
 -- We throwError if the list is not @'null'@.
@@ -717,31 +635,31 @@ assertEmptyList xs = throwError $ AssertErr $ UnexpectedNonEmptyList xs
 -- Construction helpers for simala terms
 -- ----------------------------------------------------------------------------
 
+toSimalaExpression :: SimalaTerm -> Transpiler Simala.Expr
+toSimalaExpression = \case
+  TermExpr expr -> pure expr
+  TermAttribute name [] Simala.Undefined -> pure $ Simala.Var name
+  TermAttribute name (sel:ssels) Simala.Undefined -> pure $ applySelectors name (sel:|ssels)
+  t@TermAttribute{} -> throwError $ UnexpectedSimalaTerm "TermExpr or TermAttribute"  t
+  t@TermApp{} -> throwError $ UnexpectedSimalaTerm "TermExpr or TermAttribute" t
+  t@TermFunction{} -> throwError $ UnexpectedSimalaTerm "TermExpr or TermAttribute" t
+  t@TermLetIn{} -> throwError $ UnexpectedSimalaTerm "TermExpr or TermAttribute" t
+
 mkUndefinedTerm :: SimalaTerm
 mkUndefinedTerm = TermExpr Simala.Undefined
 
 mkAssignmentTerm :: Simala.Name -> [Simala.Name] -> Simala.Expr -> Transpiler SimalaTerm
 mkAssignmentTerm name selectors expr = pure $ TermAttribute name selectors expr
 
+mkVariableTerm :: Simala.Name -> Simala.Expr -> Transpiler SimalaTerm
+mkVariableTerm name expr = pure $ TermAttribute name [] expr
+
 mkFunctionHead :: Simala.Name -> [Simala.Name] -> Transpiler SimalaTerm
 mkFunctionHead funcName funcParams = pure $ TermApp funcName funcParams
 
-mkRecordAssignmentTerm :: Simala.Name -> NE.NonEmpty Simala.Name -> Transpiler SimalaTerm
-mkRecordAssignmentTerm varName selectors =
-  pure $
-    TermAttribute
-      varName
-      (NE.toList selectors)
-      Simala.Undefined
-
-mkLetInTerm :: Simala.Name -> SimalaTerm -> Transpiler SimalaTerm
-mkLetInTerm var term = do
-  body <- assertTermExpr term
-  pure $ TermLetIn Simala.Transparent var body
-
 mkFunctionTerm :: Simala.Name -> [Simala.Name] -> SimalaTerm -> Transpiler SimalaTerm
 mkFunctionTerm fnName fnParams term = do
-  body <- assertTermExpr term
+  body <- toSimalaExpression term
   pure $ TermFunction Simala.Transparent fnName fnParams body
 
 -- | Combine two 'SimalaTerm's via a Simala 'if-then-else' expression.
@@ -856,6 +774,98 @@ mergeRecordUpdates rows = do
     mergedRows <- mergeRecordUpdates recordRows
     pure (name, mergedRows)
 
+-- ----------------------------------------------------------------------------
+-- Typed Error
+-- ----------------------------------------------------------------------------
+
+data TranspilerError
+  = TermToDeclUnsupported SimalaTerm
+  | UnsupportedLocalTerm Text SimalaTerm
+  | UnsupportedMultiTerm RnMultiTerm
+  | UnsupportedEmptyMultiTerm
+  | ImpossibleLeftSide SimalaTerm
+  | UnsupportedLeftSide RnMultiTerm
+  | UnsupportedRightSide RnMultiTerm
+  | UnexpectedSimalaTerm !Text SimalaTerm
+  | NotImplemented Text
+  | UnsupportedPredicate LS.RPRel
+  | FailedToCombineTerms SimalaTerm SimalaTerm
+  | AssertErr AssertionError
+
+data ExpectedSize
+  = SizeExact !Int
+  | SizeAtLeast !Int
+
+data AssertionError
+  = forall a. (Show a) => UnexpectedNonEmptyList [a]
+  | NotTermAttribute !SimalaTerm
+  | NotSingletonList !Text !Int
+  | NotMultiTerm !Text !RnRelationalPredicate
+  | NotRecord !Simala.Expr
+  | NotSelectorChain !SimalaTerm
+  | forall a. (Show a) => NotEquals !a !a
+  | UnexpectedEmptyList
+  | UnexpectedListSize !ExpectedSize !Int
+
+throwAssertion :: AssertionError -> Transpiler a
+throwAssertion = throwError . AssertErr
+
+renderTranspilerError :: TranspilerError -> Text
+renderTranspilerError = \case
+  TermToDeclUnsupported term ->
+    "Cannot convert SimalaTerm to Decl: " <> tshow term
+  UnsupportedLocalTerm herald term ->
+    herald <> ": Unexpected local term: " <> tshow term
+  UnsupportedMultiTerm multiTerm ->
+    "Unsupported RnMultiTerms: " <> tshow multiTerm
+  UnsupportedEmptyMultiTerm ->
+    "Unexpected empty list of RnMultiTerms"
+  ImpossibleLeftSide term ->
+    "The following SimalaTerm cannot occur on the left hand side of an assignment: " <> tshow term
+  UnsupportedLeftSide multiTerm ->
+    "Unsupported on the left side of an assignment: " <> tshow multiTerm
+  UnsupportedRightSide multiTerm ->
+    "Unsupported on the right side of an assignment: " <> tshow multiTerm
+  UnexpectedSimalaTerm herald term ->
+    "Expected " <> herald <> ", but got: " <> tshow term
+  NotImplemented herald ->
+    herald <> ": unsupported"
+  UnsupportedPredicate relPred ->
+    "Unsupported RelationalPredicate: " <> tshow relPred
+  FailedToCombineTerms term1 term2 ->
+    "Can't wrap terms in an if-then-else.\nFirst term: "
+      <> tshow term1
+      <> "\nSecond term: "
+      <> tshow term2
+  AssertErr assertionErr -> case assertionErr of
+    UnexpectedNonEmptyList list ->
+      "Expected empty list, but got: " <> tshow list
+    NotTermAttribute term ->
+      "Expected TermAttribute, but got: " <> tshow term
+    NotSingletonList herald size ->
+      herald <> ": Expected singleton list, but got: " <> tshow size
+    NotMultiTerm herald rnPred ->
+      herald <> ": Expected MultiTerm, but got: " <> tshow rnPred
+    NotRecord expr ->
+      "Expected Record, but got: " <> tshow expr
+    NotSelectorChain term ->
+      "Expected TermAttribute with non-empty selectors, but got: " <> tshow term
+    NotEquals a b ->
+      "Not equal: " <> tshow a <> ", " <> tshow b
+    UnexpectedEmptyList ->
+      "Expected non-empty list"
+    UnexpectedListSize len n ->
+      "Expected list of "
+        <> ( case len of
+              SizeExact i -> "size " <> tshow i
+              SizeAtLeast i -> "at least size " <> tshow i
+           )
+        <> ", but got "
+        <> tshow n
+
+tshow :: (Show a) => a -> Text
+tshow = Text.pack . show
+
 -- ----------------------------------------------------------------------------
 -- Debugger helpers
 -- ----------------------------------------------------------------------------
@@ -882,5 +892,5 @@ debugTranspileRule ruleSrc = do
 run :: String -> Either String LS.Rule
 run = fmap Parser.transRule . Parser.pRule . Parser.myLexer
 
-runList :: String -> Either String [LS.Rule]
-runList = fmap (fmap Parser.transRule) . Parser.pListRule . Parser.myLexer
+-- runList :: String -> Either String [LS.Rule]
+-- runList = fmap (fmap Parser.transRule) . Parser.pListRule . Parser.myLexer
diff --git a/lib/haskell/natural4/test/LS/RenamerSpec.hs b/lib/haskell/natural4/test/LS/RenamerSpec.hs
index 4b2895dfa..c1c662d6c 100644
--- a/lib/haskell/natural4/test/LS/RenamerSpec.hs
+++ b/lib/haskell/natural4/test/LS/RenamerSpec.hs
@@ -110,6 +110,25 @@ spec = do
         GIVEN x
         DECIDE x g IS x
         |]
+    test' "function-with-name-shadowing"
+      [i|
+        GIVEN x
+        DECIDE f x IS g x
+        WHERE (
+          GIVEN x DECIDE g x IS x
+        )
+        |]
+    test'
+      "function-with-name-shadowing-with-where-rules"
+      [i|
+        GIVEN x
+        DECIDE f x IS y
+        WHERE (
+          GIVETH y DECIDE y IS g x
+          §
+          GIVEN d DECIDE g d IS y WHERE y IS SUM(d, d)
+        )
+      |]
  where
   test' :: String -> String -> SpecWith (Arg (IO (Golden TL.Text)))
   test' fname ruleSource =
diff --git a/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs b/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
index 8b7e4ef86..468e56a26 100644
--- a/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
+++ b/lib/haskell/natural4/test/LS/XPile/SimalaSpec.hs
@@ -178,6 +178,36 @@ basicTests = do
             y IS A Number
       DECIDE x `discounted by` y IS SUM(x, MINUS(1, y))
     |]
+  transpilerTest "function-with-name-shadowing"
+    [i|
+      GIVEN x
+      DECIDE f x IS g x
+      WHERE (
+        GIVEN x DECIDE g x IS x
+      )
+      |]
+  transpilerTest
+    "function-with-name-shadowing-with-where-rules-1"
+    [i|
+    GIVEN x
+    DECIDE f x IS y
+    WHERE (
+      GIVETH y DECIDE y IS g x
+      §
+      GIVEN d DECIDE g d IS y WHERE y IS SUM(d, d)
+    )
+    |]
+  transpilerTest
+    "function-with-name-shadowing-with-where-rules-2"
+    [i|
+    GIVEN x
+    DECIDE f x IS y
+    WHERE (
+      GIVEN d DECIDE g d IS y WHERE y IS SUM(d, d)
+      §
+      GIVETH y DECIDE y IS g x
+    )
+    |]
 
 multiRuleTests :: Spec
 multiRuleTests = describe "multi-rules" do
diff --git a/lib/haskell/natural4/test/testdata/golden/renamer/function-with-name-shadowing-with-where-rules.expected b/lib/haskell/natural4/test/testdata/golden/renamer/function-with-name-shadowing-with-where-rules.expected
new file mode 100644
index 000000000..4a99cbc1b
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/renamer/function-with-name-shadowing-with-where-rules.expected
@@ -0,0 +1,308 @@
+Right
+    [ Hornlike
+        ( RnHornlike
+            { name =
+                [ RnExprName
+                    ( RnName
+                        { rnOccName = MTT "f" :| []
+                        , rnUniqueId = 1
+                        , rnNameType = RnFunction
+                        }
+                    )
+                , RnExprName
+                    ( RnName
+                        { rnOccName = MTT "x" :| []
+                        , rnUniqueId = 0
+                        , rnNameType = RnVariable
+                        }
+                    )
+                ]
+            , super = Nothing
+            , keyword = Decide
+            , given = Just
+                ( RnParamText
+                    { mkParamText = RnTypedMulti
+                        { rnTypedMultiExpr = RnExprName
+                            ( RnName
+                                { rnOccName = MTT "x" :| []
+                                , rnUniqueId = 0
+                                , rnNameType = RnVariable
+                                }
+                            ) :| []
+                        , rnTypedMultiTypeSig = Nothing
+                        } :| []
+                    }
+                )
+            , giveth = Nothing
+            , upon = Nothing
+            , clauses =
+                [ RnHornClause
+                    { rnHcHead = RnConstraint
+                        [ RnExprName
+                            ( RnName
+                                { rnOccName = MTT "f" :| []
+                                , rnUniqueId = 1
+                                , rnNameType = RnFunction
+                                }
+                            )
+                        , RnExprName
+                            ( RnName
+                                { rnOccName = MTT "x" :| []
+                                , rnUniqueId = 0
+                                , rnNameType = RnVariable
+                                }
+                            )
+                        ] RPis
+                        [ RnExprName
+                            ( RnName
+                                { rnOccName = MTT "y" :| []
+                                , rnUniqueId = 2
+                                , rnNameType = RnVariable
+                                }
+                            )
+                        ]
+                    , rnHcBody = Nothing
+                    }
+                ]
+            , rlabel = Nothing
+            , lsource = Nothing
+            , wwhere =
+                [ Hornlike
+                    ( RnHornlike
+                        { name =
+                            [ RnExprName
+                                ( RnName
+                                    { rnOccName = MTT "y" :| []
+                                    , rnUniqueId = 2
+                                    , rnNameType = RnVariable
+                                    }
+                                )
+                            ]
+                        , super = Nothing
+                        , keyword = Where
+                        , given = Nothing
+                        , giveth = Just
+                            ( RnParamText
+                                { mkParamText = RnTypedMulti
+                                    { rnTypedMultiExpr = RnExprName
+                                        ( RnName
+                                            { rnOccName = MTT "y" :| []
+                                            , rnUniqueId = 2
+                                            , rnNameType = RnVariable
+                                            }
+                                        ) :| []
+                                    , rnTypedMultiTypeSig = Nothing
+                                    } :| []
+                                }
+                            )
+                        , upon = Nothing
+                        , clauses =
+                            [ RnHornClause
+                                { rnHcHead = RnConstraint
+                                    [ RnExprName
+                                        ( RnName
+                                            { rnOccName = MTT "y" :| []
+                                            , rnUniqueId = 2
+                                            , rnNameType = RnVariable
+                                            }
+                                        )
+                                    ] RPis
+                                    [ RnExprName
+                                        ( RnName
+                                            { rnOccName = MTT "g" :| []
+                                            , rnUniqueId = 4
+                                            , rnNameType = RnFunction
+                                            }
+                                        )
+                                    , RnExprName
+                                        ( RnName
+                                            { rnOccName = MTT "x" :| []
+                                            , rnUniqueId = 0
+                                            , rnNameType = RnVariable
+                                            }
+                                        )
+                                    ]
+                                , rnHcBody = Nothing
+                                }
+                            ]
+                        , rlabel = Nothing
+                        , lsource = Nothing
+                        , wwhere = []
+                        , srcref = Just
+                            ( SrcRef
+                                { url = "test/Spec"
+                                , short = "test/Spec"
+                                , srcrow = 1
+                                , srccol = 1
+                                , version = Nothing
+                                }
+                            )
+                        , defaults = []
+                        , symtab = []
+                        }
+                    )
+                , Hornlike
+                    ( RnHornlike
+                        { name =
+                            [ RnExprName
+                                ( RnName
+                                    { rnOccName = MTT "g" :| []
+                                    , rnUniqueId = 4
+                                    , rnNameType = RnFunction
+                                    }
+                                )
+                            , RnExprName
+                                ( RnName
+                                    { rnOccName = MTT "d" :| []
+                                    , rnUniqueId = 3
+                                    , rnNameType = RnVariable
+                                    }
+                                )
+                            ]
+                        , super = Nothing
+                        , keyword = Where
+                        , given = Just
+                            ( RnParamText
+                                { mkParamText = RnTypedMulti
+                                    { rnTypedMultiExpr = RnExprName
+                                        ( RnName
+                                            { rnOccName = MTT "d" :| []
+                                            , rnUniqueId = 3
+                                            , rnNameType = RnVariable
+                                            }
+                                        ) :| []
+                                    , rnTypedMultiTypeSig = Nothing
+                                    } :| []
+                                }
+                            )
+                        , giveth = Nothing
+                        , upon = Nothing
+                        , clauses =
+                            [ RnHornClause
+                                { rnHcHead = RnConstraint
+                                    [ RnExprName
+                                        ( RnName
+                                            { rnOccName = MTT "g" :| []
+                                            , rnUniqueId = 4
+                                            , rnNameType = RnFunction
+                                            }
+                                        )
+                                    , RnExprName
+                                        ( RnName
+                                            { rnOccName = MTT "d" :| []
+                                            , rnUniqueId = 3
+                                            , rnNameType = RnVariable
+                                            }
+                                        )
+                                    ] RPis
+                                    [ RnExprName
+                                        ( RnName
+                                            { rnOccName = MTT "y" :| []
+                                            , rnUniqueId = 2
+                                            , rnNameType = RnVariable
+                                            }
+                                        )
+                                    ]
+                                , rnHcBody = Nothing
+                                }
+                            ]
+                        , rlabel = Nothing
+                        , lsource = Nothing
+                        , wwhere =
+                            [ Hornlike
+                                ( RnHornlike
+                                    { name =
+                                        [ RnExprName
+                                            ( RnName
+                                                { rnOccName = MTT "y" :| []
+                                                , rnUniqueId = 2
+                                                , rnNameType = RnVariable
+                                                }
+                                            )
+                                        ]
+                                    , super = Nothing
+                                    , keyword = Where
+                                    , given = Nothing
+                                    , giveth = Nothing
+                                    , upon = Nothing
+                                    , clauses =
+                                        [ RnHornClause
+                                            { rnHcHead = RnNary RPis
+                                                [ RnRelationalTerm
+                                                    [ RnExprName
+                                                        ( RnName
+                                                            { rnOccName = MTT "y" :| []
+                                                            , rnUniqueId = 2
+                                                            , rnNameType = RnVariable
+                                                            }
+                                                        )
+                                                    ]
+                                                , RnNary RPsum
+                                                    [ RnRelationalTerm
+                                                        [ RnExprName
+                                                            ( RnName
+                                                                { rnOccName = MTT "d" :| []
+                                                                , rnUniqueId = 3
+                                                                , rnNameType = RnVariable
+                                                                }
+                                                            )
+                                                        ]
+                                                    , RnRelationalTerm
+                                                        [ RnExprName
+                                                            ( RnName
+                                                                { rnOccName = MTT "d" :| []
+                                                                , rnUniqueId = 3
+                                                                , rnNameType = RnVariable
+                                                                }
+                                                            )
+                                                        ]
+                                                    ]
+                                                ]
+                                            , rnHcBody = Nothing
+                                            }
+                                        ]
+                                    , rlabel = Nothing
+                                    , lsource = Nothing
+                                    , wwhere = []
+                                    , srcref = Just
+                                        ( SrcRef
+                                            { url = "test/Spec"
+                                            , short = "test/Spec"
+                                            , srcrow = 1
+                                            , srccol = 1
+                                            , version = Nothing
+                                            }
+                                        )
+                                    , defaults = []
+                                    , symtab = []
+                                    }
+                                )
+                            ]
+                        , srcref = Just
+                            ( SrcRef
+                                { url = "test/Spec"
+                                , short = "test/Spec"
+                                , srcrow = 1
+                                , srccol = 1
+                                , version = Nothing
+                                }
+                            )
+                        , defaults = []
+                        , symtab = []
+                        }
+                    )
+                ]
+            , srcref = Just
+                ( SrcRef
+                    { url = "test/Spec"
+                    , short = "test/Spec"
+                    , srcrow = 1
+                    , srccol = 1
+                    , version = Nothing
+                    }
+                )
+            , defaults = []
+            , symtab = []
+            }
+        )
+    ]
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/renamer/function-with-name-shadowing.expected b/lib/haskell/natural4/test/testdata/golden/renamer/function-with-name-shadowing.expected
new file mode 100644
index 000000000..08178ed9c
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/renamer/function-with-name-shadowing.expected
@@ -0,0 +1,172 @@
+Right
+    [ Hornlike
+        ( RnHornlike
+            { name =
+                [ RnExprName
+                    ( RnName
+                        { rnOccName = MTT "f" :| []
+                        , rnUniqueId = 1
+                        , rnNameType = RnFunction
+                        }
+                    )
+                , RnExprName
+                    ( RnName
+                        { rnOccName = MTT "x" :| []
+                        , rnUniqueId = 0
+                        , rnNameType = RnVariable
+                        }
+                    )
+                ]
+            , super = Nothing
+            , keyword = Decide
+            , given = Just
+                ( RnParamText
+                    { mkParamText = RnTypedMulti
+                        { rnTypedMultiExpr = RnExprName
+                            ( RnName
+                                { rnOccName = MTT "x" :| []
+                                , rnUniqueId = 0
+                                , rnNameType = RnVariable
+                                }
+                            ) :| []
+                        , rnTypedMultiTypeSig = Nothing
+                        } :| []
+                    }
+                )
+            , giveth = Nothing
+            , upon = Nothing
+            , clauses =
+                [ RnHornClause
+                    { rnHcHead = RnConstraint
+                        [ RnExprName
+                            ( RnName
+                                { rnOccName = MTT "f" :| []
+                                , rnUniqueId = 1
+                                , rnNameType = RnFunction
+                                }
+                            )
+                        , RnExprName
+                            ( RnName
+                                { rnOccName = MTT "x" :| []
+                                , rnUniqueId = 0
+                                , rnNameType = RnVariable
+                                }
+                            )
+                        ] RPis
+                        [ RnExprName
+                            ( RnName
+                                { rnOccName = MTT "g" :| []
+                                , rnUniqueId = 3
+                                , rnNameType = RnFunction
+                                }
+                            )
+                        , RnExprName
+                            ( RnName
+                                { rnOccName = MTT "x" :| []
+                                , rnUniqueId = 0
+                                , rnNameType = RnVariable
+                                }
+                            )
+                        ]
+                    , rnHcBody = Nothing
+                    }
+                ]
+            , rlabel = Nothing
+            , lsource = Nothing
+            , wwhere =
+                [ Hornlike
+                    ( RnHornlike
+                        { name =
+                            [ RnExprName
+                                ( RnName
+                                    { rnOccName = MTT "g" :| []
+                                    , rnUniqueId = 3
+                                    , rnNameType = RnFunction
+                                    }
+                                )
+                            , RnExprName
+                                ( RnName
+                                    { rnOccName = MTT "x" :| []
+                                    , rnUniqueId = 2
+                                    , rnNameType = RnVariable
+                                    }
+                                )
+                            ]
+                        , super = Nothing
+                        , keyword = Where
+                        , given = Just
+                            ( RnParamText
+                                { mkParamText = RnTypedMulti
+                                    { rnTypedMultiExpr = RnExprName
+                                        ( RnName
+                                            { rnOccName = MTT "x" :| []
+                                            , rnUniqueId = 2
+                                            , rnNameType = RnVariable
+                                            }
+                                        ) :| []
+                                    , rnTypedMultiTypeSig = Nothing
+                                    } :| []
+                                }
+                            )
+                        , giveth = Nothing
+                        , upon = Nothing
+                        , clauses =
+                            [ RnHornClause
+                                { rnHcHead = RnConstraint
+                                    [ RnExprName
+                                        ( RnName
+                                            { rnOccName = MTT "g" :| []
+                                            , rnUniqueId = 3
+                                            , rnNameType = RnFunction
+                                            }
+                                        )
+                                    , RnExprName
+                                        ( RnName
+                                            { rnOccName = MTT "x" :| []
+                                            , rnUniqueId = 2
+                                            , rnNameType = RnVariable
+                                            }
+                                        )
+                                    ] RPis
+                                    [ RnExprName
+                                        ( RnName
+                                            { rnOccName = MTT "x" :| []
+                                            , rnUniqueId = 2
+                                            , rnNameType = RnVariable
+                                            }
+                                        )
+                                    ]
+                                , rnHcBody = Nothing
+                                }
+                            ]
+                        , rlabel = Nothing
+                        , lsource = Nothing
+                        , wwhere = []
+                        , srcref = Just
+                            ( SrcRef
+                                { url = "test/Spec"
+                                , short = "test/Spec"
+                                , srcrow = 1
+                                , srccol = 1
+                                , version = Nothing
+                                }
+                            )
+                        , defaults = []
+                        , symtab = []
+                        }
+                    )
+                ]
+            , srcref = Just
+                ( SrcRef
+                    { url = "test/Spec"
+                    , short = "test/Spec"
+                    , srcrow = 1
+                    , srccol = 1
+                    , version = Nothing
+                    }
+                )
+            , defaults = []
+            , symtab = []
+            }
+        )
+    ]
\ No newline at end of file
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-name-shadowing-with-where-rules-1.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-name-shadowing-with-where-rules-1.expected
new file mode 100644
index 000000000..24a9b23f5
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-name-shadowing-with-where-rules-1.expected
@@ -0,0 +1 @@
+ f_f_1 = fun (v_x_0) => let v_y_2 = f_g_4(v_x_0) in let f_g_4 = fun (v_d_3) => let v_y_2 = v_d_3 + v_d_3 in v_y_2 in v_y_2
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-name-shadowing-with-where-rules-2.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-name-shadowing-with-where-rules-2.expected
new file mode 100644
index 000000000..45dc895bc
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-name-shadowing-with-where-rules-2.expected
@@ -0,0 +1 @@
+ f_f_1 = fun (v_x_0) => let f_g_3 = fun (v_d_2) => let v_y_4 = v_d_2 + v_d_2 in v_y_4 in let v_y_4 = f_g_3(v_x_0) in v_y_4
diff --git a/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-name-shadowing.expected b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-name-shadowing.expected
new file mode 100644
index 000000000..5cd13f10a
--- /dev/null
+++ b/lib/haskell/natural4/test/testdata/golden/xpile/simala/function-with-name-shadowing.expected
@@ -0,0 +1 @@
+ f_f_1 = fun (v_x_0) => let f_g_3 = fun (v_x_2) => v_x_2 in f_g_3(v_x_0)

From e2bbb1f97858b8f7b71cb3cf293c6d498c1178a5 Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Fri, 23 Aug 2024 10:40:47 +0200
Subject: [PATCH 40/44] Fixup comment

---
 lib/haskell/natural4/src/LS/Renamer.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lib/haskell/natural4/src/LS/Renamer.hs b/lib/haskell/natural4/src/LS/Renamer.hs
index 5b6350f0e..990891a69 100644
--- a/lib/haskell/natural4/src/LS/Renamer.hs
+++ b/lib/haskell/natural4/src/LS/Renamer.hs
@@ -1018,7 +1018,7 @@ assertEmptyList xs = throwError $ AssertErr $ UnexpectedNonEmptyList (Text.pack
 
 -- ----------------------------------------------------------------------------
 -- Helper utils non specific to the renamer.
--- Should be moved out into a general purpose function.
+-- Should be moved out into a general purpose module.
 -- ----------------------------------------------------------------------------
 
 -- | Given a 'LS.MultiTerm', check whether it has the form of an attribute

From 572e9f8910e737f1cff870a7ffa4618f12b859bd Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Fri, 23 Aug 2024 11:23:54 +0200
Subject: [PATCH 41/44] Add more docs and improve Scope API

---
 lib/haskell/natural4/src/LS/Renamer.hs       | 34 ++++++++---
 lib/haskell/natural4/src/LS/Renamer/Scope.hs | 63 ++++++++++++++------
 2 files changed, 73 insertions(+), 24 deletions(-)

diff --git a/lib/haskell/natural4/src/LS/Renamer.hs b/lib/haskell/natural4/src/LS/Renamer.hs
index 990891a69..d3fabd0c2 100644
--- a/lib/haskell/natural4/src/LS/Renamer.hs
+++ b/lib/haskell/natural4/src/LS/Renamer.hs
@@ -555,7 +555,7 @@ renameTypeSignature sig = case sig of
     pure $ RnSimpleType pType rnEntityType
   LS.InlineEnum pType paramText -> do
     -- TODO: error handling, would we accept an enum such as `a IS ONE OF 1, 2, 3`?
-    -- Only if we treat them as text, which might be confusing, as user might infer
+    -- Only if we treat them as text, which might be confusing, as the user might infer
     -- this to be some kind of type checked number type.
     rnParamText <- renameGivenInlineEnumParamText paramText
     pure $ RnInlineEnum pType rnParamText
@@ -653,6 +653,20 @@ renameMultiTerm tracer multiTerms = do
     rnMultiTerms = reverse reversedRnMultiTerms
   fixFixity ctx rnMultiTerms
  where
+  -- Fixing the arity of a function requires us rewrite infix and postfix
+  -- notation to a prefix notation.
+  --
+  -- To rewrite a function application, we first gather the 'FuncInfo' to
+  -- find the declared arity of the function. Say the arity of the function @f@ is
+  -- given by the tuple @(p, q)@ where @p@ is the number of arguments before the
+  -- function name and @q@ is the number of arguments after the function name.
+  -- This captures functions applied in prefix, infix and postfix notation.
+  -- Then, we find the index of the function name as it occurs in the 'LS.MultiTerm'
+  -- and take @p@ elements from the back of the list of @[LS.MTExpr]@ that occur before
+  -- the function, which we name @ps@, and take @q@ elements from the list of
+  -- @[LS.MTExpr]@ that occur after the function name, called @qs@.
+  --
+  -- Finally, we replace the function application by @[f] ++ ps ++ qs@.
   fixFixity ctx rnMultiTerms = case ctx.multiTermContextFunctionCall of
     Nothing -> pure rnMultiTerms
     Just fnName -> do
@@ -669,7 +683,6 @@ renameMultiTerm tracer multiTerms = do
       (preArgs, postArgsWithName) = List.break (== (RnExprName fnName)) rnMultiTerms
     case postArgsWithName of
       [] -> throwError $ FixArityFunctionNotFound fnName rnMultiTerms
-      -- throwError "fixFixity: Invariant violated, function name reported, but none found."
       (fnExpr : postArgs) -> pure (preArgs, fnExpr, postArgs)
 
   processLhs name n lhs = do
@@ -873,6 +886,8 @@ prettyMultiTerm = list . Foldable.toList . fmap prettyMT
 -- Scope tables
 -- ----------------------------------------------------------------------------
 
+-- | Produce the next 'Unique' value that can be used disambiguate a resolved
+-- name.
 newUnique :: Renamer Unique
 newUnique = do
   u <- use scUniqueSupply
@@ -936,6 +951,7 @@ insertName tracer occName nameType = do
   pure rnName
 
 -- | Insert an function meta information into the current 'ScopeTable'.
+-- Overwrites existing 'FuncInfo' for the given name.
 insertFunction :: Tracer Log -> RnName -> FuncInfo -> Renamer ()
 insertFunction tracer rnFnName funcInfo = do
   traceWith tracer $ LogNewFuncInfo rnFnName funcInfo
@@ -946,6 +962,9 @@ insertFunction tracer rnFnName funcInfo = do
     )
     (Just funcInfo)
 
+-- | Lookup 'FuncInfo' for a resolved Name.
+-- Due to invariants of 'ScopeTable', this operation should never fail.
+-- However, if the invariant is violated, we throw an error.
 lookupExistingFunction :: RnName -> Renamer FuncInfo
 lookupExistingFunction rnFnName = do
   funcInfoM <- use (scScopeTable % stFunction % at rnFnName)
@@ -959,10 +978,11 @@ lookupExistingFunction rnFnName = do
 -- Note, this operation is rather expensive, so use it with caution!
 recordScopeTable :: Renamer a -> Renamer (a, ScopeTable)
 recordScopeTable act = do
-  orig <- use scScopeTable
+  prevUnique <- use scUniqueSupply
   a <- act
-  origWithNew <- use scScopeTable
-  pure (a, origWithNew `differenceScopeTable` orig)
+  scTable <- use scScopeTable
+  let scTableWithNewNames = filterScopeTable (\_ name -> name.rnUniqueId >= prevUnique) scTable
+  pure (a, scTableWithNewNames)
 
 recordScopeTable_ :: Renamer a -> Renamer ScopeTable
 recordScopeTable_ = fmap snd . recordScopeTable
@@ -977,7 +997,7 @@ data MultiTermContext = MultiTermContext
   -- ^ Did the previous 'MultiTerm' introduce a selector chain?
   -- A selector chain is introduced, if the multi term has a genitive suffix.
   -- For example: @[MTT "book's", MTT "title"]@, when @"title"@ is renamed,
-  -- the 'multiTermContextInSelector' is set expected to be to 'True', so that
+  -- the 'multiTermContextInSelector' is expected to be set to 'True', so that
   -- we can infer that @"title"@ is a 'RnSelector'.
   , multiTermContextFunctionCall :: Maybe RnName
   -- ^ While renaming a 'MultiTerm', did we encounter a function application?
@@ -1011,7 +1031,7 @@ assertNoTypeSignature (mtt, Nothing) = do
 
 -- | If we can't handle renaming certain list of things, we just hope that
 -- the parser doesn't give us a list with any elements.
--- We throwError if the list is not @'null'@.
+-- We throw an error if the list is not empty.
 assertEmptyList :: (Show a) => [a] -> Renamer [b]
 assertEmptyList [] = pure []
 assertEmptyList xs = throwError $ AssertErr $ UnexpectedNonEmptyList (Text.pack $ show xs)
diff --git a/lib/haskell/natural4/src/LS/Renamer/Scope.hs b/lib/haskell/natural4/src/LS/Renamer/Scope.hs
index 51ffea3fa..dc05866b1 100644
--- a/lib/haskell/natural4/src/LS/Renamer/Scope.hs
+++ b/lib/haskell/natural4/src/LS/Renamer/Scope.hs
@@ -10,12 +10,16 @@ module LS.Renamer.Scope (
   emptyScope,
   scScopeTable,
   scUniqueSupply,
+  -- * The ScopeTable
   ScopeTable (..),
   stVariables,
   stFunction,
+  -- * Utilities to work with 'ScopeTable'
   unionScopeTable,
   differenceScopeTable,
   emptyScopeTable,
+  filterScopeTable,
+  -- * Renamer information we keep track of for each function.
   FuncInfo (..),
   funcArity,
 ) where
@@ -25,16 +29,7 @@ import Data.Map.Strict qualified as Map
 import Optics hiding (has)
 
 import LS.Renamer.Rules
-
-data FuncInfo = FuncInfo
-  { _funcArity :: (Int, Int)
-  -- ^ Arity of a function. The first component means how many parameters
-  -- are allowed before the function, the second component how many parameters
-  -- are allowed afterwards.
-  -- For example @(1, 1)@ is a simple infix function of the form @x f y@ where @f@
-  -- is the name of the function.
-  }
-  deriving (Eq, Ord, Show)
+import qualified Data.Set as Set
 
 data Scope = Scope
   { _scScopeTable :: ScopeTable
@@ -43,6 +38,14 @@ data Scope = Scope
   }
   deriving (Eq, Ord, Show)
 
+-- | Initialise an empty environment for Scope checking.
+emptyScope :: Scope
+emptyScope =
+  Scope
+    { _scScopeTable = emptyScopeTable
+    , _scUniqueSupply = 0
+    }
+
 -- | A 'ScopeTable' keeps tab on the variables and functions that occur in a
 -- program.
 --
@@ -58,6 +61,8 @@ data ScopeTable = ScopeTable
   }
   deriving (Eq, Ord, Show)
 
+-- | Union names of a 'ScopeTable' with another 'ScopeTable'.
+-- On conflict, prefer names from the second 'ScopeTable'.
 unionScopeTable :: ScopeTable -> ScopeTable -> ScopeTable
 unionScopeTable tbl1 tbl2 =
   ScopeTable
@@ -65,6 +70,22 @@ unionScopeTable tbl1 tbl2 =
     , _stFunction = Map.union tbl2._stFunction tbl1._stFunction
     }
 
+-- | Filter the scope table, propagating changes to the '_stFunction' Map as well.
+-- Keeps all elements that satisfy the predicate.
+--
+filterScopeTable :: (OccName -> RnName -> Bool) -> ScopeTable -> ScopeTable
+filterScopeTable p tbl =
+  let
+    newVars = Map.filterWithKey p tbl._stVariables
+    newFunctions = Map.restrictKeys tbl._stFunction (Set.fromList $ Map.elems newVars)
+  in
+    ScopeTable
+      { _stVariables = newVars
+      , _stFunction = newFunctions
+      }
+
+-- | Remove all names from the first 'ScopeTable' that occur in the second
+-- 'ScopeTable'.
 differenceScopeTable :: ScopeTable -> ScopeTable -> ScopeTable
 differenceScopeTable tbl1 tbl2 =
   ScopeTable
@@ -72,6 +93,7 @@ differenceScopeTable tbl1 tbl2 =
     , _stFunction = Map.difference tbl1._stFunction tbl2._stFunction
     }
 
+-- | Create an Empty ScopeTable
 emptyScopeTable :: ScopeTable
 emptyScopeTable =
   ScopeTable
@@ -79,13 +101,20 @@ emptyScopeTable =
     , _stFunction = Map.empty
     }
 
+-- | 'FuncInfo' summarises meta information of one particular function.
+-- For now, this tracks merely the arity of each function, but might be
+-- extended in the futre.
+data FuncInfo = FuncInfo
+  { _funcArity :: (Int, Int)
+  -- ^ Arity of a function. The first component means how many parameters
+  -- are allowed before the function, the second component how many parameters
+  -- are allowed afterwards.
+  -- For example @(1, 1)@ is a simple infix function of the form @x f y@ where @f@
+  -- is the name of the function.
+  }
+  deriving (Eq, Ord, Show)
+
+
 makeFieldsNoPrefix 'Scope
 makeFieldsNoPrefix 'ScopeTable
 makeFieldsNoPrefix 'FuncInfo
-
-emptyScope :: Scope
-emptyScope =
-  Scope
-    { _scScopeTable = emptyScopeTable
-    , _scUniqueSupply = 0
-    }

From 0a3e90a2929dfae7f70714104b64fff7a6ac9f32 Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Fri, 23 Aug 2024 13:10:40 +0200
Subject: [PATCH 42/44] Remove unused module

---
 lib/haskell/natural4/natural4.cabal   | 1 -
 lib/haskell/natural4/src/LS/Logger.hs | 2 --
 2 files changed, 3 deletions(-)
 delete mode 100644 lib/haskell/natural4/src/LS/Logger.hs

diff --git a/lib/haskell/natural4/natural4.cabal b/lib/haskell/natural4/natural4.cabal
index c1e0a5832..67aca6dd2 100644
--- a/lib/haskell/natural4/natural4.cabal
+++ b/lib/haskell/natural4/natural4.cabal
@@ -35,7 +35,6 @@ library
       LS.Interpreter
       LS.Lib
       LS.Log
-      LS.Logger
       LS.NLP.NL4
       LS.NLP.NL4Transformations
       LS.NLP.NLG
diff --git a/lib/haskell/natural4/src/LS/Logger.hs b/lib/haskell/natural4/src/LS/Logger.hs
deleted file mode 100644
index e57a6db0c..000000000
--- a/lib/haskell/natural4/src/LS/Logger.hs
+++ /dev/null
@@ -1,2 +0,0 @@
-module LS.Logger where
-

From 664fb86b7998ef319cf35245198259c3f0d6a058 Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Fri, 23 Aug 2024 13:25:16 +0200
Subject: [PATCH 43/44] Bump simala commit

---
 lib/haskell/cabal.project   | 2 +-
 lib/haskell/stack.yaml      | 2 +-
 lib/haskell/stack.yaml.lock | 8 ++++----
 3 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/lib/haskell/cabal.project b/lib/haskell/cabal.project
index 190743fb9..a17d3f453 100644
--- a/lib/haskell/cabal.project
+++ b/lib/haskell/cabal.project
@@ -30,7 +30,7 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/smucclaw/simala
-  tag: 1cc4400e105cd8d6afa89cf742476d8303074d5f
+  tag: 85afeb86678a65d48bfac2bbb90306693d51582e
 
 allow-newer:
   compact:*,
diff --git a/lib/haskell/stack.yaml b/lib/haskell/stack.yaml
index c2a481393..50b923232 100644
--- a/lib/haskell/stack.yaml
+++ b/lib/haskell/stack.yaml
@@ -32,7 +32,7 @@ extra-deps:
   commit: a6d675bcbe1585fc652f95f60e0dec826a660646
 
 - github: smucclaw/simala
-  commit: 1cc4400e105cd8d6afa89cf742476d8303074d5f
+  commit: 85afeb86678a65d48bfac2bbb90306693d51582e
 
 - monad-validate-1.3.0.0
 - simple-smt-0.9.7
diff --git a/lib/haskell/stack.yaml.lock b/lib/haskell/stack.yaml.lock
index 4eb3baf1d..5eed8c609 100644
--- a/lib/haskell/stack.yaml.lock
+++ b/lib/haskell/stack.yaml.lock
@@ -53,12 +53,12 @@ packages:
     pantry-tree:
       sha256: 6c17834a398a7be0b232366d2dcb546507526035670f6380645ec2b45e962b1b
       size: 2422
-    sha256: bd5157d4abb0b1f950a15ad43e41271e5a97a220f893e3bf0fc7283725484056
-    size: 16117
-    url: https://github.com/smucclaw/simala/archive/1cc4400e105cd8d6afa89cf742476d8303074d5f.tar.gz
+    sha256: 5cdfeaa37417aedf98972a667e9fd8776a4035b8d595166b2d249226c8f54e96
+    size: 16115
+    url: https://github.com/smucclaw/simala/archive/85afeb86678a65d48bfac2bbb90306693d51582e.tar.gz
     version: '0.1'
   original:
-    url: https://github.com/smucclaw/simala/archive/1cc4400e105cd8d6afa89cf742476d8303074d5f.tar.gz
+    url: https://github.com/smucclaw/simala/archive/85afeb86678a65d48bfac2bbb90306693d51582e.tar.gz
 - completed:
     hackage: monad-validate-1.3.0.0@sha256:eb6ddd5c9cf72ff0563cba604fa00291376e96138fdb4932d00ff3a99d66706e,2605
     pantry-tree:

From 22420104dac4b593909a328e2dd6b3a8bde5c274 Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Mon, 26 Aug 2024 10:25:47 +0200
Subject: [PATCH 44/44] Remove unused language extensions

---
 lib/haskell/natural4/src/LS/Renamer.hs                | 5 -----
 lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs | 2 --
 2 files changed, 7 deletions(-)

diff --git a/lib/haskell/natural4/src/LS/Renamer.hs b/lib/haskell/natural4/src/LS/Renamer.hs
index d3fabd0c2..9720d6621 100644
--- a/lib/haskell/natural4/src/LS/Renamer.hs
+++ b/lib/haskell/natural4/src/LS/Renamer.hs
@@ -1,13 +1,8 @@
 {-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# OPTIONS_GHC -Wall #-}
 
 module LS.Renamer (
diff --git a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
index 9d0be0855..6054dfe98 100644
--- a/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
+++ b/lib/haskell/natural4/src/LS/XPile/Simala/Transpile.hs
@@ -2,8 +2,6 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE QuasiQuotes #-}
 {-# OPTIONS_GHC -Wall #-}
 
 module LS.XPile.Simala.Transpile (