Skip to content
Browse files

Expr -> Expression.

  • Loading branch information...
1 parent 138ede6 commit 3e085c45b84847a9f358afdb65ba15feb0b945c8 Sebastiaan Visser committed Dec 21, 2009
View
4 src/Compiler/CommonDefinitions.hs
@@ -1,6 +1,6 @@
module Compiler.CommonDefinitions where
-import Compiler.Expr
+import Compiler.Expression
import Compiler.Generics
import Compiler.LiftDefinitions
import Control.Arrow hiding (app)
@@ -19,7 +19,7 @@ eliminate1 (Def n e) ds =
part (Def m g) = if g == e && m /= n then Left m else Right (Def m g)
in map (\(Def m g) -> Def m (foldr (substitute1 n) g subs)) keeps
-substitute1 :: Var -> Var -> Expr -> Expr
+substitute1 :: Var -> Var -> Expression -> Expression
substitute1 to from = rec
where
tr (App f e ) = app (rec f) (rec e)
View
22 src/Compiler/Expr.hs → src/Compiler/Expression.hs
@@ -5,7 +5,7 @@
, DeriveFoldable
, DeriveTraversable
#-}
-module Compiler.Expr where
+module Compiler.Expression where
import Compiler.Generics
import Control.Monad.State
@@ -20,7 +20,7 @@ type Name = String
type Var = String
type Body = [Var] -> String
-data ExprF f =
+data ExpressionF f =
App f f
| Con Con
| Lam [Var] f
@@ -29,7 +29,7 @@ data ExprF f =
| Var Var
deriving (Functor, Foldable, Traversable)
-instance Eq f => Eq (ExprF f) where
+instance Eq f => Eq (ExpressionF f) where
App f g == App h i = f == h && g == i
Con c == Con d = c == d
Lam vs e == Lam ws f = vs == ws && e == f
@@ -38,26 +38,26 @@ instance Eq f => Eq (ExprF f) where
Var v == Var w = v == w
_ == _ = False
-type ExprA a = FixA a ExprF
-type Expr = Fix ExprF
+type ExpressionA a = FixA a ExpressionF
+type Expression = Fix ExpressionF
-- Smart constructors.
-app :: Expr -> Expr -> Expr
+app :: Expression -> Expression -> Expression
app a b = In (Id (App a b))
-con :: Con -> Expr
+con :: Con -> Expression
con a = In (Id (Con a))
-lam :: [Var] -> Expr -> Expr
+lam :: [Var] -> Expression -> Expression
lam as f = In (Id (Lam as f))
-name :: Name -> Expr -> Expr
+name :: Name -> Expression -> Expression
name a b = In (Id (Name a b))
-prim :: Body -> [Var] -> Expr
+prim :: Body -> [Var] -> Expression
prim f as = In (Id (Prim f as))
-var :: Var -> Expr
+var :: Var -> Expression
var a = In (Id (Var a))
View
8 src/Compiler/FreeVariables.hs
@@ -1,6 +1,6 @@
module Compiler.FreeVariables
( FreeVarA (..)
-, ExprFV
+, ExpressionFV
, annotateExpression
, DefinitionFV
, DefinitionsFV
@@ -10,17 +10,17 @@ module Compiler.FreeVariables
where
import Compiler.Generics
-import Compiler.Expr
+import Compiler.Expression
import Control.Arrow hiding (app)
import Data.List (intercalate)
import Data.Set hiding (map, insert)
import Compiler.LiftDefinitions (DefinitionsA (..), Definitions, DefinitionA (..))
data FreeVarA f a = FreeVarA { free :: Set String , expr :: f a }
-type ExprFV = FixA FreeVarA ExprF
+type ExpressionFV = FixA FreeVarA ExpressionF
-annotateExpression :: Arrow (~>) => Set String -> Expr ~> ExprFV
+annotateExpression :: Arrow (~>) => Set String -> Expression ~> ExpressionFV
annotateExpression globs = arr ow
where
ow ex = rec ex
View
8 src/Compiler/InstantiateLambdas.hs
@@ -1,25 +1,25 @@
module Compiler.InstantiateLambdas (instantiate, dump) where
import Compiler.Generics
-import Compiler.Expr
+import Compiler.Expression
import Control.Applicative
import Control.Arrow hiding (app)
import Control.Monad.Reader
import Data.List (intercalate)
import qualified Lang.Value as V
-instantiate :: Arrow (~>) => V.Val l i ~> Expr
+instantiate :: Arrow (~>) => V.Val l i ~> Expression
instantiate = arr (flip runReader 0 . tr)
where
- tr :: V.Val l i -> Reader Integer Expr
+ tr :: V.Val l i -> Reader Integer Expression
tr (V.App f a ) = app <$> tr f <*> tr a
tr (V.Con c ) = pure (con c)
tr (V.Lam f ) = local (+1) (ask >>= \r -> let v = 'v':show r in lam [v] <$> tr (f (V.Var v)))
tr (V.Name n e ) = name n <$> tr e
tr (V.Prim s vs) = pure (prim s vs)
tr (V.Var v ) = pure (var v)
-dump :: Arrow (~>) => Expr ~> String
+dump :: Arrow (~>) => Expression ~> String
dump = arr rec
where
tr (App f e ) = rec f ++ "(\n" ++ indent (rec e) ++ ")"
View
4 src/Compiler/LiftClosedApplications.hs
@@ -3,7 +3,7 @@ module Compiler.LiftClosedApplications (lift) where
import Compiler.FreeVariables (DefinitionsFV, FreeVarA (..))
import Compiler.Generics
import Compiler.LiftDefinitions (DefinitionA (..), DefinitionsA (..), Definition, Definitions)
-import Compiler.Expr
+import Compiler.Expression
import Control.Applicative
import Control.Arrow hiding (app)
import Control.Monad.State hiding (lift)
@@ -30,7 +30,7 @@ lift = arr (Defs . concat . zipWith single [0..] . unDefs)
mk v = 'c': (show i ++ "_" ++ show v)
- store :: Expr -> State (Integer, [Definition]) Integer
+ store :: Expression -> State (Integer, [Definition]) Integer
store e =
do modify $ \(j, defs) -> (j + 1, defs ++ [Def (mk (j + 1)) e])
gets fst
View
10 src/Compiler/LiftDefinitions.hs
@@ -10,13 +10,13 @@ module Compiler.LiftDefinitions
where
import Compiler.Generics
-import Compiler.Expr
+import Compiler.Expression
import Control.Arrow hiding (app)
import Data.List (intercalate, nubBy)
data DefinitionA a = Def
{ defName :: String
- , defExpr :: FixA a ExprF
+ , defExpr :: FixA a ExpressionF
}
newtype DefinitionsA a = Defs { unDefs :: [DefinitionA a] }
@@ -31,7 +31,7 @@ deriving instance Eq (DefinitionsA Id)
-- the definition that will be created. All named sub-expression MUST NOT
-- contain any free variables.
-inline :: Expr -> Expr
+inline :: Expression -> Expression
inline = foldId (In . Id . fmap defs)
where
defs (In (Id (Name n _))) = var n
@@ -41,7 +41,7 @@ inline = foldId (In . Id . fmap defs)
-- name/definition pairs. Because of the Map datatype all duplicate definitions
-- will be joined to a single one.
-collect :: Expr -> [Definition]
+collect :: Expression -> [Definition]
collect = reduce defs
where
defs (Name n d) = [Def n d]
@@ -50,7 +50,7 @@ collect = reduce defs
-- Lift all definitions to the top-level and inline all references to these
-- definitions in the main expression.
-lift :: Arrow (~>) => Expr ~> Definitions
+lift :: Arrow (~>) => Expression ~> Definitions
lift = arr (\e -> Defs (collect e ++ [Def "__main" (inline e)]))
eliminiateDoubles :: Arrow (~>) => Definitions ~> Definitions
View
8 src/Compiler/LiftLambdas.hs
@@ -7,15 +7,15 @@ where
import Control.Monad.State
import Control.Applicative
import Compiler.Generics
-import Compiler.Expr
+import Compiler.Expression
import Compiler.FreeVariables
import Control.Arrow hiding (app)
import qualified Data.Set as S
-- The function |addLambdaAbstractions| changes every lambda expression |e| by
-- adding abstractions for all free variables in |e| (and an |App| as well).
-addLambdaAbstractions :: Arrow (~>) => ExprFV ~> Expr
+addLambdaAbstractions :: Arrow (~>) => ExprFV ~> Expression
addLambdaAbstractions = arr ab
where
ab (In (FreeVarA _ (App l r))) = app (ab l) (ab r)
@@ -33,13 +33,13 @@ addLambdaAbstractions = arr ab
data CollectState = CollectState
{ freshVariable :: Int
- , bindings :: [Expr]
+ , bindings :: [Expression]
}
-- |collectSuperCombinators| lifts all the lambdas to supercombinators (as
-- described in the paper).
-collectSuperCombinators :: Arrow (~>) => Expr ~> Expr
+collectSuperCombinators :: Arrow (~>) => Expression ~> Expression
collectSuperCombinators = arr $ \ex ->
let (ex', st) = runState (rec ex) (CollectState 0 [])
in more (def "main" ex' : bindings st)
View
26 src/Compiler/Pipeline.hs
@@ -1,28 +1,28 @@
{-# LANGUAGE Arrows #-}
module Compiler.Pipeline where
-import Control.Arrow
-import Lang.JavaScript
-import Compiler.Expr
+import Compiler.Expression
import Compiler.FreeVariables (DefinitionsFV)
import Compiler.LiftDefinitions (Definitions)
-import qualified Compiler.InstantiateLambdas as Lambdas
+import Control.Arrow
+import Lang.JavaScript
+import qualified Compiler.CommonDefinitions as CommonDefinitions
import qualified Compiler.FreeVariables as FreeVariables
+import qualified Compiler.InstantiateLambdas as Lambdas
import qualified Compiler.LiftClosedApplications as ClosedApplications
import qualified Compiler.LiftDefinitions as Definitions
import qualified Compiler.ReindexParamaters as Parameters
-import qualified Compiler.CommonDefinitions as CommonDefinitions
type a :-> b = Kleisli IO a b
compiler :: JavaScript a -> IO String
compiler = runKleisli
- $ ( Lambdas.instantiate :: JavaScript a :-> Expr )
- >>> ( Definitions.lift :: Expr :-> Definitions )
- >>> ( Definitions.eliminiateDoubles :: Definitions :-> Definitions )
- >>> ( FreeVariables.annotateDefinitions :: Definitions :-> DefinitionsFV )
- >>> ( ClosedApplications.lift :: DefinitionsFV :-> Definitions )
- >>> ( Parameters.reindex :: Definitions :-> Definitions )
- >>> ( CommonDefinitions.eliminate :: Definitions :-> Definitions )
- >>> ( Definitions.dump :: Definitions :-> String )
+ $ ( Lambdas.instantiate :: JavaScript a :-> Expression )
+ >>> ( Definitions.lift :: Expression :-> Definitions )
+ >>> ( Definitions.eliminiateDoubles :: Definitions :-> Definitions )
+ >>> ( FreeVariables.annotateDefinitions :: Definitions :-> DefinitionsFV )
+ >>> ( ClosedApplications.lift :: DefinitionsFV :-> Definitions )
+ >>> ( Parameters.reindex :: Definitions :-> Definitions )
+ >>> ( CommonDefinitions.eliminate :: Definitions :-> Definitions )
+ >>> ( Definitions.dump :: Definitions :-> String )
View
4 src/Compiler/ReindexParamaters.hs
@@ -1,6 +1,6 @@
module Compiler.ReindexParamaters where
-import Compiler.Expr
+import Compiler.Expression
import Compiler.Generics
import Compiler.LiftDefinitions
import Control.Applicative hiding (empty)
@@ -17,7 +17,7 @@ reindex = arr (Defs . map one . unDefs)
one (Def nm x) = let e = fst $ runState (rec x) (0, empty) in Def nm e
where
- tr :: ExprF Expr -> State (Integer, Map Var Integer) Expr
+ tr :: ExpressionF Expression -> State (Integer, Map Var Integer) Expression
tr (App f e ) = app <$> rec f <*> rec e
tr (Con c ) = return (con c)
tr (Lam ps e) = do qs <- mapM (\p -> modify (\(c, m) -> (c + 1, insert p (c + 1) m)) >> gets (mk . fst)) ps
View
22 src/Compiler/Unused/LambdaLifting.lhs
@@ -4,16 +4,16 @@ First, we will start of with the module header and some imports.
> import Compiler.Generics
> import Control.Arrow hiding (app)
-> import Compiler.Expr
+> import Compiler.Expression
> import qualified Data.Set as S
> import Control.Monad.State
Lambda-lifting is done by doing three steps, as defined in
<a href="http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.30.1125">A modular fully-lazy lambda lifter in Haskell</a>
-Lambda-lifting gives us a list of definitions. The |Expr| datatype doesn't contain any |Abs| terms.
+Lambda-lifting gives us a list of definitions. The |Expression| datatype doesn't contain any |Abs| terms.
-> liftLambdas :: Kleisli IO Expr Expr
+> liftLambdas :: Kleisli IO Expression Expression
> liftLambdas = arr (more . reverse . collectSCs . abstract . freeVars)
The |freeVars| function will annotate every expression with its variables. The type of such an annotated expression is:
@@ -30,12 +30,12 @@ These are some smart constructor/destructor functions:
|freeVars| operates on simple fixpoints of |ExprF|:
-> freeVars :: Expr -> AnnExpr (S.Set String)
+> freeVars :: Expression -> AnnExpr (S.Set String)
> freeVars = freeVars' . out
|freeVars'| does the heavy lifting:
-> freeVars' :: ExprF (Expr) -> AnnExpr (S.Set String)
+> freeVars' :: ExprF (Expression) -> AnnExpr (S.Set String)
> freeVars' (App l r) = let l' = freeVars l
> r' = freeVars r
> in ae (S.union (fv l') (fv r')) (App l' r')
@@ -53,7 +53,7 @@ These are some smart constructor/destructor functions:
The function |abstract| changes every lambda expression |e| by adding
abstractions for all free variables in |e| (and an |App| as well).
-> abstract :: AnnExpr (S.Set String) -> Expr
+> abstract :: AnnExpr (S.Set String) -> Expression
> abstract = f
> where
> f (AnnExpr (_, (App l r))) = app (abstract l) (abstract r)
@@ -65,23 +65,23 @@ abstractions for all free variables in |e| (and an |App| as well).
> f (AnnExpr (_, (Def x expr))) = def x (abstract expr)
> f (AnnExpr (_, (More xs))) = more (map f xs)
-> addVars :: Expr -> [String] -> Expr
+> addVars :: Expression -> [String] -> Expression
> addVars = foldl (\e -> app e . var)
The state could be changed into a |Reader| for the |freshVariables| and a |Writer| for the bindings.
> data CollectState = CollectState
> { freshVariable :: Int
-> , bindings :: [Expr]
+> , bindings :: [Expression]
> }
collectSCs lifts all the lambdas to supercombinators (as described in the paper).
-> collectSCs :: Expr -> [Expr]
+> collectSCs :: Expression -> [Expression]
> collectSCs e = let (e', st) = runState (collectSCs' $ out e) (CollectState 0 [])
> in (In (Def "main" e')):(bindings st)
-> collectSCs' :: ExprF (Expr) -> State CollectState (Expr)
+> collectSCs' :: ExprF (Expression) -> State CollectState (Expression)
> collectSCs' (App l r) = do l' <- collectSCs' (out l)
> r' <- collectSCs' (out r)
> return (app l' r')
@@ -103,7 +103,7 @@ collectSCs lifts all the lambdas to supercombinators (as described in the paper)
Some helper functions to deal with state
-> write :: String -> Expr -> State CollectState ()
+> write :: String -> Expression -> State CollectState ()
> write nm expr = modify (\st -> st {bindings = (In (Def nm expr)):(bindings st)})
> freshName :: State CollectState String

0 comments on commit 3e085c4

Please sign in to comment.
Something went wrong with that request. Please try again.