fp-il

commit cbc3b5d7ee843d4334580c282371b92de728cb94
parent c250027607e5bbe02cd0aa5bf974c101d9d9c419
Author: Erik Oosting <crazazy@tilde.cafe>
Date:   Sat, 13 Jan 2024 00:25:54 +0100

example function

Diffstat:
M
haskell/app/Lift.hs
 | 
31
+++++++++++++++++++++++--------
M
haskell/app/Types.hs
 | 
2
--

2 files changed, 23 insertions(+), 10 deletions(-)
diff --git 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
@@ -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