diff options
| -rw-r--r-- | haskell/app/Lift.hs | 31 | ||||
| -rw-r--r-- | haskell/app/Types.hs | 2 |
2 files changed, 23 insertions, 10 deletions
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 |