fp-il

commit 03eb5c1228ea9f5997fc19f7075a90cca1d29820
parent daf044b576feb8ee61bb6be18f28985f5e87f4f4
Author: Erik Oosting <crazazy@tilde.cafe>
Date:   Mon, 18 Dec 2023 18:58:35 +0100

add free variable searching

Diffstat:
A
haskell/app/Lift.hs
 | 
26
++++++++++++++++++++++++++
M
haskell/app/Main.hs
 | 
4
++++
A
haskell/app/Types.hs
 | 
64
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
M
haskell/haskell.cabal
 | 
4
++--

4 files changed, 96 insertions(+), 2 deletions(-)
diff --git a/haskell/app/Lift.hs b/haskell/app/Lift.hs
@@ -0,0 +1,26 @@
+module Lift where
+
+import Data.Functor.Foldable
+import Data.List
+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
+
+-- | F-Algebras to find free variables
+findVars :: CExpF [String] -> [String]
+findVars (LetF ident fc rest) = converge (\\ [ident]) $ rest ++ (cata findVarsFC fc)
+findVars (IfF cond t e) = t ++ e ++ (cata findVarsAExp cond)
+findVars (FCF fc) = cata findVarsFC fc
+
+findVarsFC :: FuncallF [String] -> [String]
+findVarsFC (AtomF aexp) = cata findVarsAExp aexp
+findVarsFC (CallF id args) = id : (args >>= cata findVarsAExp)
+
+findVarsAExp :: AExpF [String] -> [String]
+findVarsAExp (IdentF ns) = [ns]
+findVarsAExp (LamF args cexp) = converge (\\ args) (fold findVars cexp)
+findVarsAExp def = foldMap id def
diff --git a/haskell/app/Main.hs b/haskell/app/Main.hs
@@ -1,4 +1,8 @@
 module Main where
 
+import LLVM.Codegen
+
+test = ppllvm
+
 main :: IO ()
 main = putStrLn "Hello, Haskell!"
diff --git a/haskell/app/Types.hs b/haskell/app/Types.hs
@@ -0,0 +1,64 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Types where
+
+import Data.Functor.Foldable.TH
+import GHC.Generics
+
+data AExp
+    = LitTrue
+    | LitFalse
+    | Ident String
+    | Number Integer
+    | LitStr String
+    | AAdd AExp AExp
+    | ASub AExp AExp
+    | AMul AExp AExp
+    | ADiv AExp AExp
+    | AGt AExp AExp
+    | ALt AExp AExp
+    | AEq AExp AExp
+    | ABsl AExp AExp
+    | ABsr AExp AExp
+    | AAnd AExp AExp
+    | AOr AExp AExp
+    | AXor AExp AExp
+    | Lam [String] CExp
+    deriving (Show, Read, Generic)
+
+data GlobalAExp
+    = GlobalLitTrue
+    | GlobalLitFalse
+    | GlobalIdent String
+    | GlobalNumber Integer
+    | GlobalLitStr String
+    | GlobalAAdd GlobalAExp GlobalAExp
+    | GlobalASub GlobalAExp GlobalAExp
+    | GlobalAMul GlobalAExp GlobalAExp
+    | GlobalADiv GlobalAExp GlobalAExp
+    | GlobalAGt GlobalAExp GlobalAExp
+    | GlobalALt GlobalAExp GlobalAExp
+    | GlobalAEq GlobalAExp GlobalAExp
+    | GlobalABsl GlobalAExp GlobalAExp
+    | GlobalABsr GlobalAExp GlobalAExp
+    | GlobalAAnd GlobalAExp GlobalAExp
+    | GlobalAOr GlobalAExp GlobalAExp
+    | GlobalAXor GlobalAExp GlobalAExp
+    | Funcref String
+    deriving (Show, Read, Generic)
+data Funcall
+    = Call String [AExp]
+    | Atom AExp
+    deriving (Show, Read, Generic)
+
+data CExp
+    = Let String Funcall CExp
+    | If AExp CExp CExp
+    | FC Funcall
+    deriving (Show, Read, Generic)
+
+makeBaseFunctor ''CExp
+makeBaseFunctor ''AExp
+makeBaseFunctor ''GlobalAExp
+makeBaseFunctor ''Funcall
diff --git a/haskell/haskell.cabal b/haskell/haskell.cabal
@@ -58,7 +58,7 @@ executable haskell
     main-is:          Main.hs
 
     -- Modules included in this executable, other than Main.
-    -- other-modules:
+    other-modules: Lift, Types
 
     -- LANGUAGE extensions used by modules in this package.
     -- other-extensions:
@@ -73,4 +73,4 @@ executable haskell
     hs-source-dirs:   app
 
     -- Base language which the package is written in.
-    default-language: Haskell2010
+    default-language: GHC2021