From cbc3b5d7ee843d4334580c282371b92de728cb94 Mon Sep 17 00:00:00 2001
From: Erik Oosting
Date: Sat, 13 Jan 2024 00:25:54 +0100
Subject: example function

---
 haskell/app/Lift.hs  | 31 +++++++++++++++++++++++--------
 haskell/app/Types.hs |  2 --
 2 files changed, 23 insertions(+), 10 deletions(-)

(limited to 'haskell/app')

diff --git a/haskell/app/Lift.hs b/haskell/app/Lift.hs
index 12f9bc6..d31eab1 100644
--- a/haskell/app/Lift.hs
+++ b/haskell/app/Lift.hs
@@ -6,19 +6,34 @@ import Types
 
 converge f a = let a' = f a in if a' == a then a else converge f a'
 
--- | R-Algebra to move external variables to arguments
-liftArgs :: AExpF (AExp, ([String], AExp)) -> ([String], AExp)
-liftArgs = undefined -- paramorphism
+factorial :: AExp
+factorial =
+    ( Lam
+        ["n"]
+        ( Let
+            "m"
+            (Call "factorial" [(ASub (Ident "n") (Number 1))])
+            ( If
+                (ALt (Ident "n") (Number 2))
+                (FC (Atom (Number 1)))
+                (FC (Atom (AMul (Ident "m") (Ident "n"))))
+            )
+        )
+    )
+
+liftArgs :: AExp -> AExp
+liftArgs lam@(Lam args body) = Lam (args ++ cata findVarsAExp lam) body
+liftArgs rest = rest
 
 -- | F-Algebras to find free variables
 findVars :: CExpF [String] -> [String]
-findVars (LetF ident fc rest) = converge (\\ [ident]) $ rest ++ (cata findVarsFC fc)
+findVars (LetF ident fc rest) = converge (\\ [ident]) $ rest ++ (findVarsFC fc)
 findVars (IfF cond t e) = t ++ e ++ (cata findVarsAExp cond)
-findVars (FCF fc) = cata findVarsFC fc
+findVars (FCF fc) = findVarsFC fc
 
-findVarsFC :: FuncallF [String] -> [String]
-findVarsFC (AtomF aexp) = cata findVarsAExp aexp
-findVarsFC (CallF id args) = id : (args >>= cata findVarsAExp)
+findVarsFC :: Funcall -> [String]
+findVarsFC (Atom aexp) = cata findVarsAExp aexp
+findVarsFC (Call id args) = id : (args >>= cata findVarsAExp)
 
 findVarsAExp :: AExpF [String] -> [String]
 findVarsAExp (IdentF ns) = [ns]
diff --git a/haskell/app/Types.hs b/haskell/app/Types.hs
index 66d4282..3f57bb9 100644
--- a/haskell/app/Types.hs
+++ b/haskell/app/Types.hs
@@ -9,7 +9,6 @@ module Types (
     AExpF (..),
     GlobalAExpF (..),
     CExpF (..),
-    FuncallF (..),
 ) where
 
 import Data.Functor.Foldable.TH
@@ -70,4 +69,3 @@ data CExp
 makeBaseFunctor ''CExp
 makeBaseFunctor ''AExp
 makeBaseFunctor ''GlobalAExp
-makeBaseFunctor ''Funcall
-- 
cgit 1.4.1-2-gfad0