From a1e9624d5ee896fe0314591ad539db995bd3b21e Mon Sep 17 00:00:00 2001
From: sebastianselander <sebastian.selander@gmail.com>
Date: Fri, 10 Feb 2023 12:09:08 +0100
Subject: [PATCH] TTGing the lambda lifter

---
 language.cabal      |  1 -
 src/Abs.hs          | 28 ++++++++++++++++++++++++++++
 src/Auxiliary.hs    |  5 -----
 src/LambdaLifter.hs | 44 ++++++++++++++++++++++++++++++++++++++------
 src/Main.hs         |  2 +-
 5 files changed, 67 insertions(+), 13 deletions(-)
 create mode 100644 src/Abs.hs
 delete mode 100644 src/Auxiliary.hs

diff --git a/language.cabal b/language.cabal
index 52b2577..3f4860c 100644
--- a/language.cabal
+++ b/language.cabal
@@ -31,7 +31,6 @@ executable language
       Grammar.Print
       Grammar.Skel
       LambdaLifter
-      Auxiliary
       -- Interpreter
 
     hs-source-dirs:   src
diff --git a/src/Abs.hs b/src/Abs.hs
new file mode 100644
index 0000000..7cc3064
--- /dev/null
+++ b/src/Abs.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE TypeFamilies, PatternSynonyms, StandaloneDeriving #-}
+
+module Abs where
+
+import Data.String
+
+data Program a = Program [Bind a]
+
+data Bind a = Bind Ident [Ident] (Exp a)
+
+newtype Ident = Ident String
+    deriving (Eq, Ord, Show, Data.String.IsString)
+
+data Exp a = EId  (IdFamily  a)  Ident
+           | EInt (IntFamily a) Integer
+           | EAdd (AddFamily a) (Exp a) (Exp a)
+           | EApp (AppFamily a) (Exp a) (Exp a)
+           | EAbs (AbsFamily a) Ident (Exp a)
+           | ELet (LetFamily a) [Bind a] (Exp a)
+           | EExp (ExpFamily a) (Exp a)
+
+type family IdFamily  a
+type family IntFamily a
+type family AddFamily a
+type family AppFamily a
+type family AbsFamily a
+type family LetFamily a
+type family ExpFamily a
diff --git a/src/Auxiliary.hs b/src/Auxiliary.hs
deleted file mode 100644
index cd844d7..0000000
--- a/src/Auxiliary.hs
+++ /dev/null
@@ -1,5 +0,0 @@
-
-module Auxiliary (module Auxiliary) where
-
-snoc :: a -> [a] -> [a]
-snoc x xs = xs ++ [x]
diff --git a/src/LambdaLifter.hs b/src/LambdaLifter.hs
index ac9cee0..79d5b8a 100644
--- a/src/LambdaLifter.hs
+++ b/src/LambdaLifter.hs
@@ -1,5 +1,4 @@
-{-# LANGUAGE LambdaCase        #-}
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE LambdaCase, OverloadedStrings, TypeFamilies, PatternSynonyms #-}
 
 
 module LambdaLifter (lambdaLift, freeVars, abstract, rename, collectScs) where
@@ -13,6 +12,8 @@ import qualified Data.Set         as Set
 import           Data.Tuple.Extra (uncurry3)
 import           Grammar.Abs
 import           Prelude          hiding (exp)
+import qualified Abs              as A
+import           Data.Void
 
 
 
@@ -74,10 +75,10 @@ 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
+             | AApp (Set Ident, AnnExp') (Set Ident, AnnExp')
+             | AAdd (Set Ident, AnnExp') (Set Ident, AnnExp') 
+             | AAbs Ident   (Set Ident, AnnExp') 
+             | ALet [ABind] (Set Ident, AnnExp') 
              deriving Show
 
 -- | Lift lambdas to let expression of the form @let sc = \x -> rhs@
@@ -219,3 +220,34 @@ mkEAbs [] e = e
 mkEAbs bs e = ELet bs e
 
 
+{----------- BOILERPLATE -----------}
+
+data LL 
+
+type instance A.IdFamily  LL = ()
+type instance A.IntFamily LL = ()
+type instance A.AddFamily LL = (Set Ident, Set Ident)
+type instance A.AppFamily LL = (Set Ident, Set Ident)
+type instance A.AbsFamily LL = Set Ident
+type instance A.LetFamily LL = Set Ident
+type instance A.ExpFamily LL = Void
+
+pattern LLId ident = A.EId () ident
+pattern LLInt int = A.EInt () int
+pattern LLAdd s1 s2 e1 e2 = A.EAdd (s1,s2) e1 e2
+pattern LLApp s1 s2 e1 e2 = A.EApp (s1,s2) e1 e2
+pattern LLAbs s i e = A.EAbs s i e
+pattern LLLet s binds e = A.ELet s binds e
+pattern LLExp v e = A.EExp v e
+
+{-
+
+data AnnExp' = AId Ident
+             | AInt Integer
+             | AApp (Set Ident, AnnExp') (Set Ident, AnnExp')
+             | AAdd (Set Ident, AnnExp') (Set Ident, AnnExp') 
+             | AAbs Ident   (Set Ident, AnnExp') 
+             | ALet [ABind] (Set Ident, AnnExp') 
+             deriving Show
+
+-}
diff --git a/src/Main.hs b/src/Main.hs
index 9af1753..d367bc1 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, rename)
+import           LambdaLifter       (lambdaLift)
 import           System.Environment (getArgs)
 import           System.Exit        (exitFailure, exitSuccess)