From 43e0f67fe2dceb87a8669c2d412be9c5e445dd3a Mon Sep 17 00:00:00 2001
From: Martin Fredin <fredin.martin@gmail.com>
Date: Sun, 22 Jan 2023 20:16:03 +0100
Subject: [PATCH 01/12] Fix conflict

---
 Grammar.cf           |   2 +-
 src/Grammar/Doc.txt  |  56 ++++++++++++++++
 src/Grammar/Print.hs | 153 +++++++++++++++++++++++++++++++++++++++++++
 src/Interpreter.hs   |   4 +-
 test_program         |   2 +-
 5 files changed, 213 insertions(+), 4 deletions(-)
 create mode 100644 src/Grammar/Doc.txt
 create mode 100644 src/Grammar/Print.hs

diff --git a/Grammar.cf b/Grammar.cf
index b258446..d880ed2 100644
--- a/Grammar.cf
+++ b/Grammar.cf
@@ -6,7 +6,7 @@ EId.  Exp3 ::= Ident   ;
 EInt. Exp3 ::= Integer ;
 EApp. Exp2 ::= Exp2 Exp3 ;
 EAdd. Exp1 ::= Exp1 "+" Exp2 ;
-EAbs. Exp  ::= "\\" Ident "->" Exp ;
+EAbs. Exp  ::= "\\" Ident "." Exp ;
 
 coercions Exp 3 ;
 
diff --git a/src/Grammar/Doc.txt b/src/Grammar/Doc.txt
new file mode 100644
index 0000000..18a68c9
--- /dev/null
+++ b/src/Grammar/Doc.txt
@@ -0,0 +1,56 @@
+The Language Grammar
+BNF Converter
+
+
+%Process by txt2tags to generate html or latex
+
+
+
+This document was automatically generated by the //BNF-Converter//. It was generated together with the lexer, the parser, and the abstract syntax module, which guarantees that the document matches with the implementation of the language (provided no hand-hacking has taken place).
+
+==The lexical structure of Grammar==
+===Identifiers===
+Identifiers //Ident// are unquoted strings beginning with a letter,
+followed by any combination of letters, digits, and the characters ``_ '``
+reserved words excluded.
+
+
+===Literals===
+Integer literals //Integer// are nonempty sequences of digits.
+
+
+
+
+===Reserved words and symbols===
+The set of reserved words is the set of terminals appearing in the grammar. Those reserved words that consist of non-letter characters are called symbols, and they are treated in a different way from those that are similar to identifiers. The lexer follows rules familiar from languages like Haskell, C, and Java, including longest match and spacing conventions.
+
+The reserved words used in Grammar are the following:
+  | ``main`` |  |  |
+
+The symbols used in Grammar are the following:
+  | = | + | \ | .
+  | ( | ) |  |
+
+===Comments===
+Single-line comments begin with --.Multiple-line comments are  enclosed with {- and -}.
+
+==The syntactic structure of Grammar==
+Non-terminals are enclosed between < and >.
+The symbols -> (production),  **|**  (union)
+and **eps** (empty rule) belong to the BNF notation.
+All other symbols are terminals.
+
+  | //Program// | -> | ``main`` ``=`` //Exp//
+  | //Exp3// | -> | //Ident//
+  |  |  **|**  | //Integer//
+  |  |  **|**  | ``(`` //Exp// ``)``
+  | //Exp2// | -> | //Exp2// //Exp3//
+  |  |  **|**  | //Exp3//
+  | //Exp1// | -> | //Exp1// ``+`` //Exp2//
+  |  |  **|**  | //Exp2//
+  | //Exp// | -> | ``\`` //Ident// ``.`` //Exp//
+  |  |  **|**  | //Exp1//
+
+
+
+%% File generated by the BNF Converter (bnfc 2.9.4.1).
diff --git a/src/Grammar/Print.hs b/src/Grammar/Print.hs
new file mode 100644
index 0000000..377a3cf
--- /dev/null
+++ b/src/Grammar/Print.hs
@@ -0,0 +1,153 @@
+-- File generated by the BNF Converter (bnfc 2.9.4.1).
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
+#if __GLASGOW_HASKELL__ <= 708
+{-# LANGUAGE OverlappingInstances #-}
+#endif
+
+-- | Pretty-printer for Grammar.
+
+module Grammar.Print where
+
+import Prelude
+  ( ($), (.)
+  , Bool(..), (==), (<)
+  , Int, Integer, Double, (+), (-), (*)
+  , String, (++)
+  , ShowS, showChar, showString
+  , all, elem, foldr, id, map, null, replicate, shows, span
+  )
+import Data.Char ( Char, isSpace )
+import qualified Grammar.Abs
+
+-- | The top-level printing method.
+
+printTree :: Print a => a -> String
+printTree = render . prt 0
+
+type Doc = [ShowS] -> [ShowS]
+
+doc :: ShowS -> Doc
+doc = (:)
+
+render :: Doc -> String
+render d = rend 0 False (map ($ "") $ d []) ""
+  where
+  rend
+    :: Int        -- ^ Indentation level.
+    -> Bool       -- ^ Pending indentation to be output before next character?
+    -> [String]
+    -> ShowS
+  rend i p = \case
+      "["      :ts -> char '[' . rend i False ts
+      "("      :ts -> char '(' . rend i False ts
+      "{"      :ts -> onNewLine i     p . showChar   '{'  . new (i+1) ts
+      "}" : ";":ts -> onNewLine (i-1) p . showString "};" . new (i-1) ts
+      "}"      :ts -> onNewLine (i-1) p . showChar   '}'  . new (i-1) ts
+      [";"]        -> char ';'
+      ";"      :ts -> char ';' . new i ts
+      t  : ts@(s:_) | closingOrPunctuation s
+                   -> pending . showString t . rend i False ts
+      t        :ts -> pending . space t      . rend i False ts
+      []           -> id
+    where
+    -- Output character after pending indentation.
+    char :: Char -> ShowS
+    char c = pending . showChar c
+
+    -- Output pending indentation.
+    pending :: ShowS
+    pending = if p then indent i else id
+
+  -- Indentation (spaces) for given indentation level.
+  indent :: Int -> ShowS
+  indent i = replicateS (2*i) (showChar ' ')
+
+  -- Continue rendering in new line with new indentation.
+  new :: Int -> [String] -> ShowS
+  new j ts = showChar '\n' . rend j True ts
+
+  -- Make sure we are on a fresh line.
+  onNewLine :: Int -> Bool -> ShowS
+  onNewLine i p = (if p then id else showChar '\n') . indent i
+
+  -- Separate given string from following text by a space (if needed).
+  space :: String -> ShowS
+  space t s =
+    case (all isSpace t', null spc, null rest) of
+      (True , _   , True ) -> []              -- remove trailing space
+      (False, _   , True ) -> t'              -- remove trailing space
+      (False, True, False) -> t' ++ ' ' : s   -- add space if none
+      _                    -> t' ++ s
+    where
+      t'          = showString t []
+      (spc, rest) = span isSpace s
+
+  closingOrPunctuation :: String -> Bool
+  closingOrPunctuation [c] = c `elem` closerOrPunct
+  closingOrPunctuation _   = False
+
+  closerOrPunct :: String
+  closerOrPunct = ")],;"
+
+parenth :: Doc -> Doc
+parenth ss = doc (showChar '(') . ss . doc (showChar ')')
+
+concatS :: [ShowS] -> ShowS
+concatS = foldr (.) id
+
+concatD :: [Doc] -> Doc
+concatD = foldr (.) id
+
+replicateS :: Int -> ShowS -> ShowS
+replicateS n f = concatS (replicate n f)
+
+-- | The printer class does the job.
+
+class Print a where
+  prt :: Int -> a -> Doc
+
+instance {-# OVERLAPPABLE #-} Print a => Print [a] where
+  prt i = concatD . map (prt i)
+
+instance Print Char where
+  prt _ c = doc (showChar '\'' . mkEsc '\'' c . showChar '\'')
+
+instance Print String where
+  prt _ = printString
+
+printString :: String -> Doc
+printString s = doc (showChar '"' . concatS (map (mkEsc '"') s) . showChar '"')
+
+mkEsc :: Char -> Char -> ShowS
+mkEsc q = \case
+  s | s == q -> showChar '\\' . showChar s
+  '\\' -> showString "\\\\"
+  '\n' -> showString "\\n"
+  '\t' -> showString "\\t"
+  s -> showChar s
+
+prPrec :: Int -> Int -> Doc -> Doc
+prPrec i j = if j < i then parenth else id
+
+instance Print Integer where
+  prt _ x = doc (shows x)
+
+instance Print Double where
+  prt _ x = doc (shows x)
+
+instance Print Grammar.Abs.Ident where
+  prt _ (Grammar.Abs.Ident i) = doc $ showString i
+instance Print Grammar.Abs.Program where
+  prt i = \case
+    Grammar.Abs.Program exp -> prPrec i 0 (concatD [doc (showString "main"), doc (showString "="), prt 0 exp])
+
+instance Print Grammar.Abs.Exp where
+  prt i = \case
+    Grammar.Abs.EId id_ -> prPrec i 3 (concatD [prt 0 id_])
+    Grammar.Abs.EInt n -> prPrec i 3 (concatD [prt 0 n])
+    Grammar.Abs.EApp exp1 exp2 -> prPrec i 2 (concatD [prt 2 exp1, prt 3 exp2])
+    Grammar.Abs.EAdd exp1 exp2 -> prPrec i 1 (concatD [prt 1 exp1, doc (showString "+"), prt 2 exp2])
+    Grammar.Abs.EAbs id_ exp -> prPrec i 0 (concatD [doc (showString "\\"), prt 0 id_, doc (showString "."), prt 0 exp])
diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index bdbd8d2..378c95b 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -39,7 +39,7 @@ eval cxt = \case
 
   EInt i    -> pure $ VInt i
 
-  --  γ     ⊢ e  ⇓ let δ in λx → f
+  --  γ     ⊢ e  ⇓ let δ in λx. f
   --  γ     ⊢ e₁ ⇓ v
   --  δ,x=v ⊢ f  ⇓ v₁
   --  ------------------------------
@@ -54,7 +54,7 @@ eval cxt = \case
 
   --
   --  -----------------------------
-  --  γ ⊢ λx → f ⇓ let γ in λx → f
+  --  γ ⊢ λx. f ⇓ let γ in λx. f
 
   EAbs x e  -> pure $ VClosure cxt x e
 
diff --git a/test_program b/test_program
index 83f3e9a..95235e4 100644
--- a/test_program
+++ b/test_program
@@ -2,4 +2,4 @@
 
 
 
-main = (\x -> x + x + 3) ((\x -> x) 2)
+main = (\x. x + x + 3) ((\x. x) 2)

From 6607173b9353c8458967c097ea5bf4053ef5ba05 Mon Sep 17 00:00:00 2001
From: Patrik Jansson <patrik.ja@gmail.com>
Date: Fri, 3 Feb 2023 11:12:44 +0100
Subject: [PATCH 02/12] Typo fix (to check access).

---
 .gitignore     | 1 +
 language.cabal | 2 +-
 2 files changed, 2 insertions(+), 1 deletion(-)

diff --git a/.gitignore b/.gitignore
index 5aa7a08..5112877 100644
--- a/.gitignore
+++ b/.gitignore
@@ -3,3 +3,4 @@ dist-newstyle
 *.x
 *.bak
 src/Grammar
+/language
diff --git a/language.cabal b/language.cabal
index fc1c2fe..aac5d02 100644
--- a/language.cabal
+++ b/language.cabal
@@ -12,7 +12,7 @@ build-type:         Simple
 
 extra-doc-files:    CHANGELOG.md
 
-extra-source-fiels:
+extra-source-files:
   Grammar.cf
 
 

From 84eb430c41c8abd8a14e7d25197c600ee1b4ec37 Mon Sep 17 00:00:00 2001
From: sebastianselander <sebastian.selander@gmail.com>
Date: Fri, 3 Feb 2023 11:29:42 +0100
Subject: [PATCH 03/12] relaxed base dependency and added overwrite

---
 language.cabal | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/language.cabal b/language.cabal
index aac5d02..5734655 100644
--- a/language.cabal
+++ b/language.cabal
@@ -35,7 +35,7 @@ executable language
     hs-source-dirs:   src
 
     build-depends:    
-        base ^>=4.16.3.0
+        base >=4.16
       , mtl
       , containers
       , either

From b6693815726c08192d4a80761bfe8c1f0f4e3785 Mon Sep 17 00:00:00 2001
From: Martin Fredin <fredin.martin@gmail.com>
Date: Thu, 9 Feb 2023 05:18:49 +0100
Subject: [PATCH 04/12] Remove files from git

---
 src/Grammar/Doc.txt  |  56 ----------------
 src/Grammar/Print.hs | 153 -------------------------------------------
 2 files changed, 209 deletions(-)
 delete mode 100644 src/Grammar/Doc.txt
 delete mode 100644 src/Grammar/Print.hs

diff --git a/src/Grammar/Doc.txt b/src/Grammar/Doc.txt
deleted file mode 100644
index 18a68c9..0000000
--- a/src/Grammar/Doc.txt
+++ /dev/null
@@ -1,56 +0,0 @@
-The Language Grammar
-BNF Converter
-
-
-%Process by txt2tags to generate html or latex
-
-
-
-This document was automatically generated by the //BNF-Converter//. It was generated together with the lexer, the parser, and the abstract syntax module, which guarantees that the document matches with the implementation of the language (provided no hand-hacking has taken place).
-
-==The lexical structure of Grammar==
-===Identifiers===
-Identifiers //Ident// are unquoted strings beginning with a letter,
-followed by any combination of letters, digits, and the characters ``_ '``
-reserved words excluded.
-
-
-===Literals===
-Integer literals //Integer// are nonempty sequences of digits.
-
-
-
-
-===Reserved words and symbols===
-The set of reserved words is the set of terminals appearing in the grammar. Those reserved words that consist of non-letter characters are called symbols, and they are treated in a different way from those that are similar to identifiers. The lexer follows rules familiar from languages like Haskell, C, and Java, including longest match and spacing conventions.
-
-The reserved words used in Grammar are the following:
-  | ``main`` |  |  |
-
-The symbols used in Grammar are the following:
-  | = | + | \ | .
-  | ( | ) |  |
-
-===Comments===
-Single-line comments begin with --.Multiple-line comments are  enclosed with {- and -}.
-
-==The syntactic structure of Grammar==
-Non-terminals are enclosed between < and >.
-The symbols -> (production),  **|**  (union)
-and **eps** (empty rule) belong to the BNF notation.
-All other symbols are terminals.
-
-  | //Program// | -> | ``main`` ``=`` //Exp//
-  | //Exp3// | -> | //Ident//
-  |  |  **|**  | //Integer//
-  |  |  **|**  | ``(`` //Exp// ``)``
-  | //Exp2// | -> | //Exp2// //Exp3//
-  |  |  **|**  | //Exp3//
-  | //Exp1// | -> | //Exp1// ``+`` //Exp2//
-  |  |  **|**  | //Exp2//
-  | //Exp// | -> | ``\`` //Ident// ``.`` //Exp//
-  |  |  **|**  | //Exp1//
-
-
-
-%% File generated by the BNF Converter (bnfc 2.9.4.1).
diff --git a/src/Grammar/Print.hs b/src/Grammar/Print.hs
deleted file mode 100644
index 377a3cf..0000000
--- a/src/Grammar/Print.hs
+++ /dev/null
@@ -1,153 +0,0 @@
--- File generated by the BNF Converter (bnfc 2.9.4.1).
-
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE LambdaCase #-}
-#if __GLASGOW_HASKELL__ <= 708
-{-# LANGUAGE OverlappingInstances #-}
-#endif
-
--- | Pretty-printer for Grammar.
-
-module Grammar.Print where
-
-import Prelude
-  ( ($), (.)
-  , Bool(..), (==), (<)
-  , Int, Integer, Double, (+), (-), (*)
-  , String, (++)
-  , ShowS, showChar, showString
-  , all, elem, foldr, id, map, null, replicate, shows, span
-  )
-import Data.Char ( Char, isSpace )
-import qualified Grammar.Abs
-
--- | The top-level printing method.
-
-printTree :: Print a => a -> String
-printTree = render . prt 0
-
-type Doc = [ShowS] -> [ShowS]
-
-doc :: ShowS -> Doc
-doc = (:)
-
-render :: Doc -> String
-render d = rend 0 False (map ($ "") $ d []) ""
-  where
-  rend
-    :: Int        -- ^ Indentation level.
-    -> Bool       -- ^ Pending indentation to be output before next character?
-    -> [String]
-    -> ShowS
-  rend i p = \case
-      "["      :ts -> char '[' . rend i False ts
-      "("      :ts -> char '(' . rend i False ts
-      "{"      :ts -> onNewLine i     p . showChar   '{'  . new (i+1) ts
-      "}" : ";":ts -> onNewLine (i-1) p . showString "};" . new (i-1) ts
-      "}"      :ts -> onNewLine (i-1) p . showChar   '}'  . new (i-1) ts
-      [";"]        -> char ';'
-      ";"      :ts -> char ';' . new i ts
-      t  : ts@(s:_) | closingOrPunctuation s
-                   -> pending . showString t . rend i False ts
-      t        :ts -> pending . space t      . rend i False ts
-      []           -> id
-    where
-    -- Output character after pending indentation.
-    char :: Char -> ShowS
-    char c = pending . showChar c
-
-    -- Output pending indentation.
-    pending :: ShowS
-    pending = if p then indent i else id
-
-  -- Indentation (spaces) for given indentation level.
-  indent :: Int -> ShowS
-  indent i = replicateS (2*i) (showChar ' ')
-
-  -- Continue rendering in new line with new indentation.
-  new :: Int -> [String] -> ShowS
-  new j ts = showChar '\n' . rend j True ts
-
-  -- Make sure we are on a fresh line.
-  onNewLine :: Int -> Bool -> ShowS
-  onNewLine i p = (if p then id else showChar '\n') . indent i
-
-  -- Separate given string from following text by a space (if needed).
-  space :: String -> ShowS
-  space t s =
-    case (all isSpace t', null spc, null rest) of
-      (True , _   , True ) -> []              -- remove trailing space
-      (False, _   , True ) -> t'              -- remove trailing space
-      (False, True, False) -> t' ++ ' ' : s   -- add space if none
-      _                    -> t' ++ s
-    where
-      t'          = showString t []
-      (spc, rest) = span isSpace s
-
-  closingOrPunctuation :: String -> Bool
-  closingOrPunctuation [c] = c `elem` closerOrPunct
-  closingOrPunctuation _   = False
-
-  closerOrPunct :: String
-  closerOrPunct = ")],;"
-
-parenth :: Doc -> Doc
-parenth ss = doc (showChar '(') . ss . doc (showChar ')')
-
-concatS :: [ShowS] -> ShowS
-concatS = foldr (.) id
-
-concatD :: [Doc] -> Doc
-concatD = foldr (.) id
-
-replicateS :: Int -> ShowS -> ShowS
-replicateS n f = concatS (replicate n f)
-
--- | The printer class does the job.
-
-class Print a where
-  prt :: Int -> a -> Doc
-
-instance {-# OVERLAPPABLE #-} Print a => Print [a] where
-  prt i = concatD . map (prt i)
-
-instance Print Char where
-  prt _ c = doc (showChar '\'' . mkEsc '\'' c . showChar '\'')
-
-instance Print String where
-  prt _ = printString
-
-printString :: String -> Doc
-printString s = doc (showChar '"' . concatS (map (mkEsc '"') s) . showChar '"')
-
-mkEsc :: Char -> Char -> ShowS
-mkEsc q = \case
-  s | s == q -> showChar '\\' . showChar s
-  '\\' -> showString "\\\\"
-  '\n' -> showString "\\n"
-  '\t' -> showString "\\t"
-  s -> showChar s
-
-prPrec :: Int -> Int -> Doc -> Doc
-prPrec i j = if j < i then parenth else id
-
-instance Print Integer where
-  prt _ x = doc (shows x)
-
-instance Print Double where
-  prt _ x = doc (shows x)
-
-instance Print Grammar.Abs.Ident where
-  prt _ (Grammar.Abs.Ident i) = doc $ showString i
-instance Print Grammar.Abs.Program where
-  prt i = \case
-    Grammar.Abs.Program exp -> prPrec i 0 (concatD [doc (showString "main"), doc (showString "="), prt 0 exp])
-
-instance Print Grammar.Abs.Exp where
-  prt i = \case
-    Grammar.Abs.EId id_ -> prPrec i 3 (concatD [prt 0 id_])
-    Grammar.Abs.EInt n -> prPrec i 3 (concatD [prt 0 n])
-    Grammar.Abs.EApp exp1 exp2 -> prPrec i 2 (concatD [prt 2 exp1, prt 3 exp2])
-    Grammar.Abs.EAdd exp1 exp2 -> prPrec i 1 (concatD [prt 1 exp1, doc (showString "+"), prt 2 exp2])
-    Grammar.Abs.EAbs id_ exp -> prPrec i 0 (concatD [doc (showString "\\"), prt 0 id_, doc (showString "."), prt 0 exp])

From 1f47288fcffde023ee23d84aa188762246a57771 Mon Sep 17 00:00:00 2001
From: Martin Fredin <fredin.martin@gmail.com>
Date: Thu, 9 Feb 2023 05:19:51 +0100
Subject: [PATCH 05/12] Implement lambda lifting passes: freeVars, abstract,
 and rename

---
 Grammar.cf          |  28 ++++---
 language.cabal      |   4 +-
 src/LambdaLifter.hs | 173 ++++++++++++++++++++++++++++++++++++++++++++
 src/Main.hs         |  29 ++++----
 4 files changed, 211 insertions(+), 23 deletions(-)
 create mode 100644 src/LambdaLifter.hs

diff --git a/Grammar.cf b/Grammar.cf
index d880ed2..9dba2f5 100644
--- a/Grammar.cf
+++ b/Grammar.cf
@@ -1,15 +1,25 @@
 
 
-Program. Program ::= "main" "=" Exp ;
+Program. Program ::= [ScDef];
 
-EId.  Exp3 ::= Ident   ;
-EInt. Exp3 ::= Integer ;
-EApp. Exp2 ::= Exp2 Exp3 ;
-EAdd. Exp1 ::= Exp1 "+" Exp2 ;
-EAbs. Exp  ::= "\\" Ident "." Exp ;
+ScDef. ScDef ::= Bind; 
+separator ScDef ";";
 
-coercions Exp 3 ;
+separator Ident " ";
 
-comment "--" ;
-comment "{-" "-}" ;
+
+EId.  Exp3 ::= Ident;
+EInt. Exp3 ::= Integer;
+ELet. Exp3 ::= "let" [Bind] "in" Exp; 
+EApp. Exp2 ::= Exp2 Exp3;
+EAdd. Exp1 ::= Exp1 "+" Exp2;
+EAbs. Exp  ::= "\\" Ident "." Exp;
+
+Bind. Bind ::= Ident [Ident] "=" Exp;
+separator Bind ";";
+
+coercions Exp 3;
+
+comment "--";
+comment "{-" "-}";
 
diff --git a/language.cabal b/language.cabal
index 5734655..3f4860c 100644
--- a/language.cabal
+++ b/language.cabal
@@ -30,7 +30,8 @@ executable language
       Grammar.Par
       Grammar.Print
       Grammar.Skel
-      Interpreter
+      LambdaLifter
+      -- Interpreter
 
     hs-source-dirs:   src
 
@@ -40,5 +41,6 @@ executable language
       , containers
       , either
       , array
+      , extra
 
     default-language: GHC2021
diff --git a/src/LambdaLifter.hs b/src/LambdaLifter.hs
new file mode 100644
index 0000000..6e1463d
--- /dev/null
+++ b/src/LambdaLifter.hs
@@ -0,0 +1,173 @@
+{-# LANGUAGE LambdaCase        #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms   #-}
+
+
+module LambdaLifter (lambdaLift, freeVars, abstract) where
+
+import           Data.List        (mapAccumL)
+import           Data.Map         (Map)
+import qualified Data.Map         as Map
+import           Data.Maybe       (fromJust)
+import           Data.Set         (Set, (\\))
+import qualified Data.Set         as Set
+import           Data.Tuple.Extra (uncurry3)
+import           Grammar.Abs
+import           Prelude          hiding (exp)
+
+pattern Sc :: Ident -> [Ident] -> Exp -> ScDef
+pattern Sc n xs e = ScDef (Bind n xs e)
+
+
+
+lambdaLift :: Program -> Program
+lambdaLift = rename . abstract . freeVars
+
+
+-- Annotate free variables
+
+freeVars :: Program -> AnnProgram
+freeVars (Program ds) = [ (n, xs, freeVarsExp (Set.fromList xs) e)
+                        | Sc n xs e <- ds
+                        ]
+
+
+freeVarsExp :: Set Ident -> Exp -> AnnExp
+freeVarsExp lv = \case
+
+  EId n | Set.member n lv -> (Set.singleton n, AId n)
+        | otherwise       -> (mempty, AId n)
+
+  EInt i     -> (mempty, AInt i)
+
+  EApp e1 e2 -> (Set.union (freeVarsOf e1') (freeVarsOf e2'), AApp e1' e2')
+    where e1' = freeVarsExp lv e1
+          e2' = freeVarsExp lv e2
+
+  EAdd e1 e2 -> (Set.union (freeVarsOf e1') (freeVarsOf e2'), AAdd e1' e2')
+    where e1' = freeVarsExp lv e1
+          e2' = freeVarsExp lv e2
+
+  EAbs n  e  -> (Set.delete n $ freeVarsOf e', AAbs n e')
+    where e'  = freeVarsExp (Set.insert n lv) e
+
+  ELet bs e  -> (Set.union bsFree eFree, ALet bs' e')
+    where
+      bsFree       = freeInValues \\ nsSet
+      eFree        = freeVarsOf e' \\ nsSet
+      bs'          = zipWith3 ABind ns xs es'
+      e'           = freeVarsExp e_lv e
+      (ns, xs, es) = fromBinders bs
+      nsSet        = Set.fromList ns
+      e_lv         = Set.union lv nsSet
+      es'          = map (freeVarsExp e_lv) es
+      freeInValues = foldr1 Set.union (map freeVarsOf es')
+
+
+
+freeVarsOf :: AnnExp -> Set Ident
+freeVarsOf = fst
+
+fromBinders :: [Bind] -> ([Ident], [[Ident]], [Exp])
+fromBinders bs = unzip3 [ (n, xs, e) | Bind n xs e <- bs ]
+
+-- Lift lambda expression into let with binder "sc"
+
+abstract :: AnnProgram -> Program
+abstract p = Program
+  [ Sc sc_name xs $ abstractExp rhs
+  | (sc_name, xs, rhs) <- p
+  ]
+
+
+abstractExp :: AnnExp -> Exp
+abstractExp (free, exp) = case exp of
+  AId  n     -> EId n
+  AInt i     -> EInt i
+  AApp e1 e2 -> EApp (abstractExp e1) (abstractExp e2)
+  AAdd e1 e2 -> EAdd (abstractExp e1) (abstractExp e2)
+  ALet bs e  -> ELet [Bind n xs (abstractExp e1) | ABind n xs e1 <- bs ] $ abstractExp e
+  AAbs n  e  -> foldl EApp sc (map EId fvList)
+    where
+      fvList = Set.toList free
+      bind = Bind "sc" [] e'
+      e' = foldr EAbs (abstractExp e) (fvList ++ [n])
+      sc = ELet [bind] (EId (Ident "sc"))
+
+-- rename pass
+
+rename :: Program -> Program
+rename (Program ds) = Program $ map (uncurry3 Sc) tuples
+  where
+    tuples = snd (mapAccumL renameSc 0 ds)
+    renameSc i (Sc n xs e) = (i2, (n, xs', e'))
+      where
+        (i1, xs', env) = newNames i xs
+        (i2, e')       = renameExp env i1 e
+
+renameExp :: Map Ident Ident -> Int -> Exp -> (Int, Exp)
+renameExp env i = \case
+
+
+  EId  n     -> (i, maybe (error "no") EId $ Map.lookup n env)
+
+
+  EInt i1    -> (i, EInt i1)
+
+  EApp e1 e2 -> (i2, EApp e1' e2')
+    where
+      (i1, e1') = renameExp env i e1
+      (i2, e2') = renameExp env i1 e2
+
+  EAdd e1 e2 -> (i2, EAdd e1' e2')
+    where
+      (i1, e1') = renameExp env i e1
+      (i2, e2') = renameExp env i1 e2
+
+  ELet bs e  -> (i3, ELet (zipWith3 Bind ns' xs es') e')
+    where
+      (i1, e')        = renameExp e_env i e
+      (ns, xs, es)    = fromBinders bs
+      (i2, ns', env') = newNames i1 ns
+      e_env           = Map.union env' env
+      (i3, es')       = mapAccumL (renameExp e_env) i2 es
+
+
+  EAbs n  e  -> (i2, EAbs (head ns) e')
+    where
+      (i1, ns, env') = newNames i [n]
+      (i2, e')       = renameExp (Map.union env' env ) i1 e
+
+
+newNames :: Int -> [Ident] -> (Int, [Ident], Map Ident Ident)
+newNames i old_names = (i', new_names, env)
+  where
+    (i', new_names) = getNames i old_names
+    env = Map.fromList $ zip old_names new_names
+
+
+getName :: Int -> Ident -> (Int, Ident)
+getName i (Ident s) = (i + 1, makeName s i)
+
+getNames :: Int -> [Ident] -> (Int, [Ident])
+getNames i ns = (i + length ss, zipWith makeName ss [i..])
+  where
+    ss = map (\(Ident s) -> s) ns
+
+makeName :: String -> Int -> Ident
+makeName prefix i = Ident (prefix ++ "_" ++ show i)
+
+-- Annotated AST
+
+type AnnProgram = [(Ident, [Ident], AnnExp)]
+type AnnExp = (Set Ident, AnnExp')
+
+data ABind = ABind Ident [Ident] AnnExp deriving Show
+
+data AnnExp' = AId Ident
+             | AInt Integer
+             | AApp AnnExp  AnnExp
+             | AAdd AnnExp  AnnExp
+             | AAbs Ident   AnnExp
+             | ALet [ABind] AnnExp
+             deriving Show
diff --git a/src/Main.hs b/src/Main.hs
index ed753f2..58aafe5 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,11 +1,11 @@
 {-# LANGUAGE LambdaCase #-}
 module Main where
 
-import           Control.Monad.Except (runExcept)
-import           Grammar.Par          (myLexer, pProgram)
-import           Interpreter          (interpret)
-import           System.Environment   (getArgs)
-import           System.Exit          (exitFailure, exitSuccess)
+import           Grammar.Par        (myLexer, pProgram)
+import           Grammar.Print      (printTree)
+import           LambdaLifter       (abstract, freeVars, lambdaLift)
+import           System.Environment (getArgs)
+import           System.Exit        (exitFailure, exitSuccess)
 
 main :: IO ()
 main = getArgs >>= \case
@@ -17,14 +17,17 @@ main = getArgs >>= \case
        putStrLn "SYNTAX ERROR"
        putStrLn err
        exitFailure
-      Right prg -> case runExcept $ interpret prg of
-        Left err -> do
-          putStrLn "INTERPRETER ERROR"
-          putStrLn err
-          exitFailure
-        Right i -> do
-          print i
-          exitSuccess
+      Right prg -> do
+        putStrLn "-- Parser"
+        putStrLn $ printTree prg
+        putStrLn "\n--Lamda lifter"
+        putStrLn "\n--freevars"
+        print $ freeVars prg
+        putStrLn "\n--abstract"
+        putStrLn . printTree $ (abstract . freeVars) prg
+        putStrLn "\n--renamed"
+        putStrLn . printTree $ lambdaLift prg
+        exitSuccess
 
 
 

From 7a2404cf74b4fffcd649fab330c61b7158b5034e Mon Sep 17 00:00:00 2001
From: Martin Fredin <fredin.martin@gmail.com>
Date: Thu, 9 Feb 2023 06:19:58 +0100
Subject: [PATCH 06/12] Finish Lambda Lifter

---
 basic-2             |  4 +++
 src/LambdaLifter.hs | 76 ++++++++++++++++++++++++++++++++++++++++-----
 src/Main.hs         |  7 +----
 3 files changed, 74 insertions(+), 13 deletions(-)
 create mode 100644 basic-2

diff --git a/basic-2 b/basic-2
new file mode 100644
index 0000000..8afd060
--- /dev/null
+++ b/basic-2
@@ -0,0 +1,4 @@
+add x = \y. x + y;
+
+main = (\z. z + z) ((add 4) 6);
+
diff --git a/src/LambdaLifter.hs b/src/LambdaLifter.hs
index 6e1463d..512155d 100644
--- a/src/LambdaLifter.hs
+++ b/src/LambdaLifter.hs
@@ -3,12 +3,12 @@
 {-# LANGUAGE PatternSynonyms   #-}
 
 
-module LambdaLifter (lambdaLift, freeVars, abstract) where
+module LambdaLifter (lambdaLift, freeVars, abstract, rename, collectScs) where
 
 import           Data.List        (mapAccumL)
 import           Data.Map         (Map)
 import qualified Data.Map         as Map
-import           Data.Maybe       (fromJust)
+import           Data.Maybe       (fromMaybe)
 import           Data.Set         (Set, (\\))
 import qualified Data.Set         as Set
 import           Data.Tuple.Extra (uncurry3)
@@ -21,7 +21,7 @@ pattern Sc n xs e = ScDef (Bind n xs e)
 
 
 lambdaLift :: Program -> Program
-lambdaLift = rename . abstract . freeVars
+lambdaLift = collectScs . rename . abstract . freeVars
 
 
 -- Annotate free variables
@@ -94,7 +94,7 @@ abstractExp (free, exp) = case exp of
       e' = foldr EAbs (abstractExp e) (fvList ++ [n])
       sc = ELet [bind] (EId (Ident "sc"))
 
--- rename pass
+-- Rename
 
 rename :: Program -> Program
 rename (Program ds) = Program $ map (uncurry3 Sc) tuples
@@ -108,9 +108,7 @@ rename (Program ds) = Program $ map (uncurry3 Sc) tuples
 renameExp :: Map Ident Ident -> Int -> Exp -> (Int, Exp)
 renameExp env i = \case
 
-
-  EId  n     -> (i, maybe (error "no") EId $ Map.lookup n env)
-
+  EId  n     -> (i, EId . fromMaybe n $ Map.lookup n env)
 
   EInt i1    -> (i, EInt i1)
 
@@ -157,6 +155,70 @@ getNames i ns = (i + length ss, zipWith makeName ss [i..])
 makeName :: String -> Int -> Ident
 makeName prefix i = Ident (prefix ++ "_" ++ show i)
 
+
+-- Collect supercombinators
+
+collectScs :: Program -> Program
+collectScs (Program ds) = Program $ concatMap collect_one_sc ds
+  where
+    collect_one_sc (Sc n xs e) = Sc n xs e' : scs
+      where (scs, e') = collectScsExp e
+
+
+
+collectScsExp :: Exp -> ([ScDef], Exp)
+collectScsExp = \case
+
+  EId  n     -> ([], EId n)
+
+  EInt i     -> ([], EInt i)
+
+  EApp e1 e2 -> (scs1 ++ scs2, EApp e1' e2')
+    where
+      (scs1, e1') = collectScsExp e1
+      (scs2, e2') = collectScsExp e2
+
+  EAdd e1 e2 -> (scs1 ++ scs2, EAdd e1' e2')
+    where
+      (scs1, e1') = collectScsExp e1
+      (scs2, e2') = collectScsExp e2
+
+  EAbs x  e  -> (scs, EAbs x e')
+    where
+      (scs, e') = collectScsExp e
+
+  ELet bs e  -> (rhss_scs ++ e_scs ++ local_scs, mkEAbs non_scs' e')
+    where
+      (rhss_scs, bs') = mapAccumL collectScs_d [] bs
+      scs'            = [ Sc n xs rhs | Sc n xs rhs <- bs', isEAbs rhs]
+      non_scs'        = [ Bind n xs rhs | Sc n xs rhs <- bs', not $ isEAbs rhs]
+      local_scs       = map peelLambda scs'
+      -- local_scs       = [ Sc n (xs ++ [x]) e1 | Sc n xs (EAbs x e1) <- scs']
+      (e_scs, e')     = collectScsExp e
+
+      collectScs_d scs (Bind n xs rhs) = (scs ++ rhs_scs1, Sc n xs rhs')
+        where
+          (rhs_scs1, rhs') = collectScsExp rhs
+
+
+
+peelLambda :: ScDef -> ScDef
+peelLambda sc@(Sc n xs e) = case e of
+                           EAbs x e1 -> peelLambda (Sc n (xs ++ [x]) e1)
+                           _         -> sc
+
+
+
+isEAbs :: Exp -> Bool
+isEAbs = \case
+  EAbs {} -> True
+  _       -> False
+
+mkEAbs :: [Bind] -> Exp -> Exp
+mkEAbs [] e = e
+mkEAbs bs e = ELet bs e
+
+
 -- Annotated AST
 
 type AnnProgram = [(Ident, [Ident], AnnExp)]
diff --git a/src/Main.hs b/src/Main.hs
index 58aafe5..ee5a0a1 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -3,7 +3,7 @@ module Main where
 
 import           Grammar.Par        (myLexer, pProgram)
 import           Grammar.Print      (printTree)
-import           LambdaLifter       (abstract, freeVars, lambdaLift)
+import           LambdaLifter       (abstract, freeVars, lambdaLift, rename)
 import           System.Environment (getArgs)
 import           System.Exit        (exitFailure, exitSuccess)
 
@@ -21,11 +21,6 @@ main = getArgs >>= \case
         putStrLn "-- Parser"
         putStrLn $ printTree prg
         putStrLn "\n--Lamda lifter"
-        putStrLn "\n--freevars"
-        print $ freeVars prg
-        putStrLn "\n--abstract"
-        putStrLn . printTree $ (abstract . freeVars) prg
-        putStrLn "\n--renamed"
         putStrLn . printTree $ lambdaLift prg
         exitSuccess
 

From ce31e4d49056c252d9295c07bf267a81de6a6882 Mon Sep 17 00:00:00 2001
From: Martin Fredin <fredin.martin@gmail.com>
Date: Thu, 9 Feb 2023 17:53:39 +0100
Subject: [PATCH 07/12] Fix first unnecessary supercombinator

---
 Grammar.cf              |  9 ++----
 basic-2                 |  4 ---
 sample-programs/basic-1 |  2 ++
 sample-programs/basic-2 |  4 +++
 sample-programs/basic-3 |  2 ++
 sample-programs/basic-4 |  2 ++
 sample-programs/basic-5 |  9 ++++++
 src/LambdaLifter.hs     | 72 ++++++++++++++++++++++-------------------
 src/Main.hs             |  8 +++--
 test_program            |  5 ---
 10 files changed, 66 insertions(+), 51 deletions(-)
 delete mode 100644 basic-2
 create mode 100644 sample-programs/basic-1
 create mode 100644 sample-programs/basic-2
 create mode 100644 sample-programs/basic-3
 create mode 100644 sample-programs/basic-4
 create mode 100644 sample-programs/basic-5
 delete mode 100644 test_program

diff --git a/Grammar.cf b/Grammar.cf
index 9dba2f5..410d11d 100644
--- a/Grammar.cf
+++ b/Grammar.cf
@@ -1,12 +1,6 @@
 
 
-Program. Program ::= [ScDef];
-
-ScDef. ScDef ::= Bind; 
-separator ScDef ";";
-
-separator Ident " ";
-
+Program. Program ::= [Bind];
 
 EId.  Exp3 ::= Ident;
 EInt. Exp3 ::= Integer;
@@ -17,6 +11,7 @@ EAbs. Exp  ::= "\\" Ident "." Exp;
 
 Bind. Bind ::= Ident [Ident] "=" Exp;
 separator Bind ";";
+separator Ident " ";
 
 coercions Exp 3;
 
diff --git a/basic-2 b/basic-2
deleted file mode 100644
index 8afd060..0000000
--- a/basic-2
+++ /dev/null
@@ -1,4 +0,0 @@
-add x = \y. x + y;
-
-main = (\z. z + z) ((add 4) 6);
-
diff --git a/sample-programs/basic-1 b/sample-programs/basic-1
new file mode 100644
index 0000000..f109950
--- /dev/null
+++ b/sample-programs/basic-1
@@ -0,0 +1,2 @@
+
+f = \x. x+1;
diff --git a/sample-programs/basic-2 b/sample-programs/basic-2
new file mode 100644
index 0000000..4b8ead0
--- /dev/null
+++ b/sample-programs/basic-2
@@ -0,0 +1,4 @@
+add x = \y. x+y;
+
+main = (\z. z+z) ((add 4) 6);
+
diff --git a/sample-programs/basic-3 b/sample-programs/basic-3
new file mode 100644
index 0000000..9443439
--- /dev/null
+++ b/sample-programs/basic-3
@@ -0,0 +1,2 @@
+
+main = (\x. x+x+3) ((\x. x) 2)
diff --git a/sample-programs/basic-4 b/sample-programs/basic-4
new file mode 100644
index 0000000..1de7a8c
--- /dev/null
+++ b/sample-programs/basic-4
@@ -0,0 +1,2 @@
+
+f x = let g = (\y. y+1) in g (g x)
diff --git a/sample-programs/basic-5 b/sample-programs/basic-5
new file mode 100644
index 0000000..3168484
--- /dev/null
+++ b/sample-programs/basic-5
@@ -0,0 +1,9 @@
+id x = x;
+
+add x y = x + y;
+
+double n = n + n;
+
+apply f x = \y -> f x y;
+
+main = apply (id add) ((\x. x + 1) 1) (double 3);
diff --git a/src/LambdaLifter.hs b/src/LambdaLifter.hs
index 512155d..c9253b6 100644
--- a/src/LambdaLifter.hs
+++ b/src/LambdaLifter.hs
@@ -1,6 +1,5 @@
 {-# LANGUAGE LambdaCase        #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PatternSynonyms   #-}
 
 
 module LambdaLifter (lambdaLift, freeVars, abstract, rename, collectScs) where
@@ -15,20 +14,14 @@ import           Data.Tuple.Extra (uncurry3)
 import           Grammar.Abs
 import           Prelude          hiding (exp)
 
-pattern Sc :: Ident -> [Ident] -> Exp -> ScDef
-pattern Sc n xs e = ScDef (Bind n xs e)
-
-
-
 lambdaLift :: Program -> Program
 lambdaLift = collectScs . rename . abstract . freeVars
 
-
 -- Annotate free variables
 
 freeVars :: Program -> AnnProgram
 freeVars (Program ds) = [ (n, xs, freeVarsExp (Set.fromList xs) e)
-                        | Sc n xs e <- ds
+                        | Bind n xs e <- ds
                         ]
 
 
@@ -64,7 +57,6 @@ freeVarsExp lv = \case
       freeInValues = foldr1 Set.union (map freeVarsOf es')
 
 
-
 freeVarsOf :: AnnExp -> Set Ident
 freeVarsOf = fst
 
@@ -74,10 +66,21 @@ fromBinders bs = unzip3 [ (n, xs, e) | Bind n xs e <- bs ]
 -- Lift lambda expression into let with binder "sc"
 
 abstract :: AnnProgram -> Program
-abstract p = Program
-  [ Sc sc_name xs $ abstractExp rhs
-  | (sc_name, xs, rhs) <- p
-  ]
+abstract prog = Program $ map f prog
+  where
+  f :: (Ident, [Ident], AnnExp) -> Bind
+  f (name, pars, rhs@(_, e)) =
+    case e of
+      AAbs par body -> Bind name (snoc par pars) $ abstractExp body
+      _             -> Bind name pars            $ abstractExp rhs
+
+
+
+-- [ case rhs of
+--     EAbs par body -> Bind name (snoc par pars) body
+--     _             -> Bind name pars rhs
+--
+-- | (name, pars, rhs) <- prog
 
 
 abstractExp :: AnnExp -> Exp
@@ -94,13 +97,17 @@ abstractExp (free, exp) = case exp of
       e' = foldr EAbs (abstractExp e) (fvList ++ [n])
       sc = ELet [bind] (EId (Ident "sc"))
 
+
+snoc :: a -> [a] -> [a]
+snoc x xs = xs ++ [x]
+
 -- Rename
 
 rename :: Program -> Program
-rename (Program ds) = Program $ map (uncurry3 Sc) tuples
+rename (Program ds) = Program $ map (uncurry3 Bind) tuples
   where
     tuples = snd (mapAccumL renameSc 0 ds)
-    renameSc i (Sc n xs e) = (i2, (n, xs', e'))
+    renameSc i (Bind n xs e) = (i2, (n, xs', e'))
       where
         (i1, xs', env) = newNames i xs
         (i2, e')       = renameExp env i1 e
@@ -159,14 +166,23 @@ makeName prefix i = Ident (prefix ++ "_" ++ show i)
 -- Collect supercombinators
 
 collectScs :: Program -> Program
-collectScs (Program ds) = Program $ concatMap collect_one_sc ds
+collectScs (Program ds) = Program $ concatMap collectOneSc ds
   where
-    collect_one_sc (Sc n xs e) = Sc n xs e' : scs
-      where (scs, e') = collectScsExp e
+    collectOneSc (Bind name args rhs) = Bind name args rhs' : scs
+      where (scs, rhs') = collectScsExp rhs
+  {-
 
 
 
-collectScsExp :: Exp -> ([ScDef], Exp)
+Bind (Ident "f") []
+
+  (ELet [Bind (Ident "sc") [] (EAbs (Ident "x") (EAdd (EId (Ident "x")) (EInt 1)))] (EId (Ident "sc")))
+
+
+  -}
+
+
+collectScsExp :: Exp -> ([Bind], Exp)
 collectScsExp = \case
 
   EId  n     -> ([], EId n)
@@ -190,25 +206,15 @@ collectScsExp = \case
   ELet bs e  -> (rhss_scs ++ e_scs ++ local_scs, mkEAbs non_scs' e')
     where
       (rhss_scs, bs') = mapAccumL collectScs_d [] bs
-      scs'            = [ Sc n xs rhs | Sc n xs rhs <- bs', isEAbs rhs]
-      non_scs'        = [ Bind n xs rhs | Sc n xs rhs <- bs', not $ isEAbs rhs]
-      local_scs       = map peelLambda scs'
-      -- local_scs       = [ Sc n (xs ++ [x]) e1 | Sc n xs (EAbs x e1) <- scs']
+      scs'            = [ Bind n xs rhs | Bind n xs rhs <- bs', isEAbs rhs]
+      non_scs'        = [ Bind n xs rhs | Bind n xs rhs <- bs', not $ isEAbs rhs]
+      local_scs       = [ Bind n (xs ++ [x]) e1 | Bind n xs (EAbs x e1) <- scs']
       (e_scs, e')     = collectScsExp e
 
-      collectScs_d scs (Bind n xs rhs) = (scs ++ rhs_scs1, Sc n xs rhs')
+      collectScs_d scs (Bind n xs rhs) = (scs ++ rhs_scs1, Bind n xs rhs')
         where
           (rhs_scs1, rhs') = collectScsExp rhs
 
-
-
-peelLambda :: ScDef -> ScDef
-peelLambda sc@(Sc n xs e) = case e of
-                           EAbs x e1 -> peelLambda (Sc n (xs ++ [x]) e1)
-                           _         -> sc
-
-
-
 isEAbs :: Exp -> Bool
 isEAbs = \case
   EAbs {} -> True
diff --git a/src/Main.hs b/src/Main.hs
index ee5a0a1..211bf3a 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -18,9 +18,13 @@ main = getArgs >>= \case
        putStrLn err
        exitFailure
       Right prg -> do
-        putStrLn "-- Parser"
+        putStrLn "-- Parse"
         putStrLn $ printTree prg
-        putStrLn "\n--Lamda lifter"
+        putStrLn "\n-- Abstract"
+        putStrLn . printTree $ (abstract . freeVars) prg
+        putStrLn "\n-- Rename"
+        putStrLn . printTree $ (rename . abstract . freeVars) prg
+        putStrLn "\n-- Lamda lifter"
         putStrLn . printTree $ lambdaLift prg
         exitSuccess
 
diff --git a/test_program b/test_program
deleted file mode 100644
index 95235e4..0000000
--- a/test_program
+++ /dev/null
@@ -1,5 +0,0 @@
-
-
-
-
-main = (\x. x + x + 3) ((\x. x) 2)

From 23261ec380040a198eb9df626debfe23bc26fa85 Mon Sep 17 00:00:00 2001
From: Martin Fredin <fredin.martin@gmail.com>
Date: Thu, 9 Feb 2023 20:23:20 +0100
Subject: [PATCH 08/12] Add llvm dep

---
 shell.nix | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/shell.nix b/shell.nix
index 0c7624a..2eaf1cd 100644
--- a/shell.nix
+++ b/shell.nix
@@ -6,7 +6,7 @@ pkgs.haskellPackages.developPackage {
   withHoogle = true;
   modifier = drv:
   pkgs.haskell.lib.addBuildTools drv (
-    (with pkgs; [ hlint haskell-language-server ghc jasmin ])
+    (with pkgs; [ hlint haskell-language-server ghc jasmin llvmPackages_15.libllvm])
     ++
     (with pkgs.haskellPackages; [ 
       cabal-install

From 7c313b3faad5bb5b3a4439300c736e81c8140645 Mon Sep 17 00:00:00 2001
From: Martin Fredin <fredin.martin@gmail.com>
Date: Thu, 9 Feb 2023 20:23:49 +0100
Subject: [PATCH 09/12] Fix basic tests

---
 Makefile                | 7 +++++++
 sample-programs/basic-5 | 2 +-
 2 files changed, 8 insertions(+), 1 deletion(-)

diff --git a/Makefile b/Makefile
index 16b753d..6e8a54d 100644
--- a/Makefile
+++ b/Makefile
@@ -22,4 +22,11 @@ clean :
 	rm -r src/Grammar
 	rm language
 
+test :
+	./language ./sample-programs/basic-1
+	./language ./sample-programs/basic-2
+	./language ./sample-programs/basic-3
+	./language ./sample-programs/basic-4
+	./language ./sample-programs/basic-5
+
 # EOF
diff --git a/sample-programs/basic-5 b/sample-programs/basic-5
index 3168484..9984ddd 100644
--- a/sample-programs/basic-5
+++ b/sample-programs/basic-5
@@ -4,6 +4,6 @@ add x y = x + y;
 
 double n = n + n;
 
-apply f x = \y -> f x y;
+apply f x = \y. f x y;
 
 main = apply (id add) ((\x. x + 1) 1) (double 3);

From 07bec3e7ef6111960e96c5ac8695624ee68bffa8 Mon Sep 17 00:00:00 2001
From: Martin Fredin <fredin.martin@gmail.com>
Date: Thu, 9 Feb 2023 20:24:06 +0100
Subject: [PATCH 10/12] Add auxiliary module

---
 Auxiliary.hs   | 5 +++++
 language.cabal | 1 +
 2 files changed, 6 insertions(+)
 create mode 100644 Auxiliary.hs

diff --git a/Auxiliary.hs b/Auxiliary.hs
new file mode 100644
index 0000000..cd844d7
--- /dev/null
+++ b/Auxiliary.hs
@@ -0,0 +1,5 @@
+
+module Auxiliary (module Auxiliary) where
+
+snoc :: a -> [a] -> [a]
+snoc x xs = xs ++ [x]
diff --git a/language.cabal b/language.cabal
index 3f4860c..52b2577 100644
--- a/language.cabal
+++ b/language.cabal
@@ -31,6 +31,7 @@ executable language
       Grammar.Print
       Grammar.Skel
       LambdaLifter
+      Auxiliary
       -- Interpreter
 
     hs-source-dirs:   src

From 59fb773bc1cc3d8d37531a08df223a706d2dc7a2 Mon Sep 17 00:00:00 2001
From: Martin Fredin <fredin.martin@gmail.com>
Date: Thu, 9 Feb 2023 20:24:25 +0100
Subject: [PATCH 11/12] Some clean up and documenting

---
 src/LambdaLifter.hs | 62 +++++++++++++++------------------------------
 src/Main.hs         |  9 ++++---
 2 files changed, 26 insertions(+), 45 deletions(-)

diff --git a/src/LambdaLifter.hs b/src/LambdaLifter.hs
index c9253b6..ac9cee0 100644
--- a/src/LambdaLifter.hs
+++ b/src/LambdaLifter.hs
@@ -14,17 +14,19 @@ import           Data.Tuple.Extra (uncurry3)
 import           Grammar.Abs
 import           Prelude          hiding (exp)
 
+
+
+-- | Lift lambdas and let expression into supercombinators.
 lambdaLift :: Program -> Program
 lambdaLift = collectScs . rename . abstract . freeVars
 
--- Annotate free variables
 
+-- | Annotate free variables
 freeVars :: Program -> AnnProgram
 freeVars (Program ds) = [ (n, xs, freeVarsExp (Set.fromList xs) e)
                         | Bind n xs e <- ds
                         ]
 
-
 freeVarsExp :: Set Ident -> Exp -> AnnExp
 freeVarsExp lv = \case
 
@@ -63,8 +65,22 @@ freeVarsOf = fst
 fromBinders :: [Bind] -> ([Ident], [[Ident]], [Exp])
 fromBinders bs = unzip3 [ (n, xs, e) | Bind n xs e <- bs ]
 
--- Lift lambda expression into let with binder "sc"
+-- AST annotated with free variables
+type AnnProgram = [(Ident, [Ident], AnnExp)]
 
+type AnnExp = (Set Ident, AnnExp')
+
+data ABind = ABind Ident [Ident] AnnExp deriving Show
+
+data AnnExp' = AId Ident
+             | AInt Integer
+             | AApp AnnExp  AnnExp
+             | AAdd AnnExp  AnnExp
+             | AAbs Ident   AnnExp
+             | ALet [ABind] AnnExp
+             deriving Show
+
+-- | Lift lambdas to let expression of the form @let sc = \x -> rhs@
 abstract :: AnnProgram -> Program
 abstract prog = Program $ map f prog
   where
@@ -74,15 +90,6 @@ abstract prog = Program $ map f prog
       AAbs par body -> Bind name (snoc par pars) $ abstractExp body
       _             -> Bind name pars            $ abstractExp rhs
 
-
-
--- [ case rhs of
---     EAbs par body -> Bind name (snoc par pars) body
---     _             -> Bind name pars rhs
---
--- | (name, pars, rhs) <- prog
-
-
 abstractExp :: AnnExp -> Exp
 abstractExp (free, exp) = case exp of
   AId  n     -> EId n
@@ -101,8 +108,7 @@ abstractExp (free, exp) = case exp of
 snoc :: a -> [a] -> [a]
 snoc x xs = xs ++ [x]
 
--- Rename
-
+-- | Rename all supercombinators and variables
 rename :: Program -> Program
 rename (Program ds) = Program $ map (uncurry3 Bind) tuples
   where
@@ -163,24 +169,12 @@ makeName :: String -> Int -> Ident
 makeName prefix i = Ident (prefix ++ "_" ++ show i)
 
 
--- Collect supercombinators
-
+-- | Collects supercombinators by lifting appropriate let expressions
 collectScs :: Program -> Program
 collectScs (Program ds) = Program $ concatMap collectOneSc ds
   where
     collectOneSc (Bind name args rhs) = Bind name args rhs' : scs
       where (scs, rhs') = collectScsExp rhs
-  {-
-
-
-
-Bind (Ident "f") []
-
-  (ELet [Bind (Ident "sc") [] (EAbs (Ident "x") (EAdd (EId (Ident "x")) (EInt 1)))] (EId (Ident "sc")))
-
-
-  -}
-
 
 collectScsExp :: Exp -> ([Bind], Exp)
 collectScsExp = \case
@@ -225,17 +219,3 @@ mkEAbs [] e = e
 mkEAbs bs e = ELet bs e
 
 
--- Annotated AST
-
-type AnnProgram = [(Ident, [Ident], AnnExp)]
-type AnnExp = (Set Ident, AnnExp')
-
-data ABind = ABind Ident [Ident] AnnExp deriving Show
-
-data AnnExp' = AId Ident
-             | AInt Integer
-             | AApp AnnExp  AnnExp
-             | AAdd AnnExp  AnnExp
-             | AAbs Ident   AnnExp
-             | ALet [ABind] AnnExp
-             deriving Show
diff --git a/src/Main.hs b/src/Main.hs
index 211bf3a..9af1753 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -20,12 +20,13 @@ main = getArgs >>= \case
       Right prg -> do
         putStrLn "-- Parse"
         putStrLn $ printTree prg
-        putStrLn "\n-- Abstract"
-        putStrLn . printTree $ (abstract . freeVars) prg
-        putStrLn "\n-- Rename"
-        putStrLn . printTree $ (rename . abstract . freeVars) prg
+        -- putStrLn "\n-- Abstract"
+        -- putStrLn . printTree $ (abstract . freeVars) prg
+        -- putStrLn "\n-- Rename"
+        -- putStrLn . printTree $ (rename . abstract . freeVars) prg
         putStrLn "\n-- Lamda lifter"
         putStrLn . printTree $ lambdaLift prg
+        putStrLn ""
         exitSuccess
 
 

From 3ac8377fa01259f91986d5833693c6911bd0e8ca Mon Sep 17 00:00:00 2001
From: Martin Fredin <fredin.martin@gmail.com>
Date: Thu, 9 Feb 2023 20:25:00 +0100
Subject: [PATCH 12/12] Fix auxiliary path

---
 Auxiliary.hs => src/Auxiliary.hs | 0
 1 file changed, 0 insertions(+), 0 deletions(-)
 rename Auxiliary.hs => src/Auxiliary.hs (100%)

diff --git a/Auxiliary.hs b/src/Auxiliary.hs
similarity index 100%
rename from Auxiliary.hs
rename to src/Auxiliary.hs