diff options
author | Erik Oosting | 2023-12-18 18:58:35 +0100 |
---|---|---|
committer | Erik Oosting | 2023-12-18 18:58:35 +0100 |
commit | 03eb5c1228ea9f5997fc19f7075a90cca1d29820 (patch) | |
tree | e49cc06de0417120aea1f26b39fbf0913e534d12 | |
parent | daf044b576feb8ee61bb6be18f28985f5e87f4f4 (diff) |
add free variable searching
-rw-r--r-- | haskell/app/Lift.hs | 26 | ||||
-rw-r--r-- | haskell/app/Main.hs | 4 | ||||
-rw-r--r-- | haskell/app/Types.hs | 64 | ||||
-rw-r--r-- | haskell/haskell.cabal | 4 |
4 files changed, 96 insertions, 2 deletions
diff --git a/haskell/app/Lift.hs b/haskell/app/Lift.hs new file mode 100644 index 0000000..12f9bc6 --- /dev/null +++ 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 index 65ae4a0..4b26cb2 100644 --- 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 new file mode 100644 index 0000000..8c4790f --- /dev/null +++ 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 index e6abb24..0333b6d 100644 --- 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 |