summary refs log tree commit diff
path: root/haskell/app/Lift.hs
blob: 12f9bc6685d3cdd6b5e5625f15784af9fa71b050 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
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