Permalink
Browse files

Definitions don't have explicit main expression. Last definition is a…

…lways main.
  • Loading branch information...
1 parent 42cc1b1 commit a04e83181a8a67d9b226919af70aabc5df755de0 Sebastiaan Visser committed Dec 20, 2009
@@ -2,6 +2,8 @@ module Compiler.FreeVariables
( FreeVarA (..)
, ExprFV
, annotateExpression
+, DefinitionFV
+, DefinitionsFV
, annotateDefinitions
, dump
)
@@ -12,7 +14,7 @@ import Compiler.Raw
import Control.Arrow hiding (app)
import Data.List (intercalate)
import Data.Set hiding (map, insert)
-import Compiler.LiftDefinitions (DefinitionsA (..), Definitions)
+import Compiler.LiftDefinitions (DefinitionsA (..), Definitions, DefinitionA (..))
data FreeVarA f a = FreeVarA { free :: Set String , expr :: f a }
@@ -37,19 +39,19 @@ annotateExpression globs = arr ow
ae vs e = In (FreeVarA vs e)
fv = free . out
+type DefinitionFV = DefinitionA FreeVarA
type DefinitionsFV = DefinitionsA FreeVarA
annotateDefinitions :: Arrow (~>) => Definitions ~> DefinitionsFV
-annotateDefinitions = arr $ \(Defs ds m) ->
- let globs = fromList (map fst ds)
+annotateDefinitions = arr $ \(Defs ds) ->
+ let globs = fromList (map defName ds)
ann = annotateExpression globs
- in Defs (map (fmap ann) ds) (ann m)
+ in Defs (map (\(Def n e) -> Def n (ann e)) ds)
dump :: Arrow (~>) => DefinitionsFV ~> String
-dump = arr def
+dump = arr (intercalate "\n" . map one . unDefs)
where
- def (Defs ds m) = intercalate "\n" (map single (ds ++ [("__main", m)]))
- single (d, e) = d ++ " = " ++ rec e
+ one (Def d e) = "var " ++ d ++ " = " ++ rec e
tr (App f e ) = rec f ++ "(" ++ rec e ++ ")"
tr (Con c ) = c
@@ -1,4 +1,4 @@
-module Compiler.Instantiate (instantiateLambas, printExpression) where
+module Compiler.InstantiateLambdas (instantiate, dump) where
import Compiler.Generics
import Compiler.Raw
@@ -8,8 +8,8 @@ import Control.Monad.Reader
import Data.List (intercalate)
import qualified Lang.Value as V
-instantiateLambas :: Arrow (~>) => V.Val l i ~> Expr
-instantiateLambas = arr (flip runReader 0 . tr)
+instantiate :: Arrow (~>) => V.Val l i ~> Expr
+instantiate = arr (flip runReader 0 . tr)
where
tr :: V.Val l i -> Reader Integer Expr
tr (V.App f a) = app <$> tr f <*> tr a
@@ -19,8 +19,8 @@ instantiateLambas = arr (flip runReader 0 . tr)
tr (V.Prim s vs) = pure (prim s vs)
tr (V.Var v) = pure (var v)
-printExpression :: Arrow (~>) => Expr ~> String
-printExpression = arr rec
+dump :: Arrow (~>) => Expr ~> String
+dump = arr rec
where
tr (App f e) = rec f ++ "(\n" ++ indent (rec e) ++ ")"
tr (Con c) = c
@@ -0,0 +1,35 @@
+module Compiler.LiftClosedApplications (lift) where
+
+import Compiler.FreeVariables (DefinitionsFV, FreeVarA (..))
+import Compiler.Generics
+import Compiler.LiftDefinitions (DefinitionA (..), DefinitionsA (..), Definition, Definitions)
+import Compiler.Raw
+import Control.Applicative
+import Control.Arrow hiding (app)
+import Control.Monad.State hiding (lift)
+import Data.Traversable
+import qualified Data.Set as S
+
+lift :: Arrow (~>) => DefinitionsFV ~> Definitions
+lift = arr (Defs . concatMap single . unDefs)
+
+ where
+ single (Def n e) = let (g, (_, ds)) = runState (coll e) (0, []) in ds ++ [Def n g]
+
+ coll (In (FreeVarA vf e)) =
+ if S.size vf == 0 && liftable e
+ then var . mk <$> (rec e >>= store)
+ else rec e
+
+ rec = fmap (In . Id) . traverse coll
+
+ liftable (App _ _) = True
+ liftable _ = False
+
+ mk = ('c':) . show
+
+ store :: Expr -> State (Integer, [Definition]) Integer
+ store e =
+ do modify $ \(i, defs) -> (i + 1, defs ++ [Def (mk (i + 1)) e])
+ gets fst
+
@@ -1,38 +0,0 @@
-module Compiler.LiftClosures where
-
-import Control.Applicative
-import Compiler.FreeVariables
-import Compiler.Generics
-import Compiler.Raw
-import Control.Arrow hiding (app)
-import Control.Monad.State
-import Data.Traversable
-import qualified Data.Set as S
-import qualified Data.Map as M
-
-liftClosures :: Arrow (~>) => ExprFV ~> Expr
-liftClosures = arr (flip evalState (0, M.empty) . collectAll)
-
-collectAll :: ExprFV -> State (Integer, M.Map Integer Expr) Expr
-collectAll (In (FreeVarA vf x)) =
- if and [S.size vf == 0, liftable x]
- then do s <- rec x >>= collectSingle
- return (var ('c': show s))
- else rec x
- where rec (Def n d) = do z <- collectAll d
- mp <- gets snd
- modify (\(a, _) -> (a, M.empty))
- return (more (M.elems mp ++ [def n z]))
- rec e = In . Id <$> traverse collectAll e
-
-collectSingle :: Expr -> State (Integer, M.Map Integer Expr) Integer
-collectSingle e =
- do modify $ \(i, store) ->
- let v = i + 1 :: Integer
- in (v, M.insert v (def ('c':show v) e) store)
- gets fst
-
-liftable :: ExprF t -> Bool
-liftable (App _ _) = True
-liftable _ = False
-
@@ -1,5 +1,6 @@
module Compiler.LiftDefinitions
-( DefTable
+( DefinitionA (..)
+, Definition
, DefinitionsA (..)
, Definitions
, inline
@@ -14,13 +15,14 @@ import Compiler.Raw
import Control.Arrow hiding (app)
import Data.List (intercalate)
-type DefTable a = [(String, FixA a ExprF)]
-
-data DefinitionsA a = Defs
- { definitions :: DefTable a
- , expression :: FixA a ExprF
+data DefinitionA a = Def
+ { defName :: String
+ , defExpr :: FixA a ExprF
}
+newtype DefinitionsA a = Defs { unDefs :: [DefinitionA a] }
+
+type Definition = DefinitionA Id
type Definitions = DefinitionsA Id
-- All named sub-expressions will be replaces by a variables that references
@@ -37,23 +39,22 @@ 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 -> DefTable Id
+collect :: Expr -> [Definition]
collect = reduce defs
where
- defs d@(Name n _) = [(n, In (Id d))]
+ defs d@(Name n _) = [Def n (In (Id d))]
defs _ = []
-- Lift all definitions to the top-level and inline all references to these
-- definitions in the main expression.
lift :: Arrow (~>) => Expr ~> Definitions
-lift = arr (uncurry Defs . (collect &&& inline))
+lift = arr (\e -> Defs (collect e ++ [Def "__main" (inline e)]))
dump :: Arrow (~>) => Definitions ~> String
-dump = arr def
+dump = arr (intercalate "\n" . map one . unDefs)
where
- def (Defs ds m) = intercalate "\n" (map single (ds ++ [("__main", m)]))
- single (d, e) = d ++ " = " ++ rec e
+ one (Def d e) = "var " ++ d ++ " = " ++ rec e
tr (App f e ) = rec f ++ "(" ++ rec e ++ ")"
tr (Con c ) = c
View
@@ -1,23 +1,18 @@
{-# LANGUAGE Arrows #-}
module Compiler.Pipeline where
-import Compiler.Instantiate
import Control.Arrow
-import Lang.Value
-import qualified Compiler.FreeVariables as FreeVariables
-import qualified Compiler.LiftDefinitions as Definitions
--- import Compiler.LiftClosures
--- import Compiler.LiftLambdas
+import Lang.Value (Val)
+import qualified Compiler.InstantiateLambdas as Lambdas
+import qualified Compiler.FreeVariables as FreeVariables
+import qualified Compiler.LiftClosedApplications as ClosedApplications
+import qualified Compiler.LiftDefinitions as Definitions
compiler :: Val l i -> IO String
compiler = runKleisli
- $ instantiateLambas
+ $ Lambdas.instantiate
>>> Definitions.lift
>>> FreeVariables.annotateDefinitions
--- >>> liftClosures
- >>> FreeVariables.dump
+ >>> ClosedApplications.lift
+ >>> Definitions.dump
--- >>> addLambdaAbstractions
--- >>> collectSuperCombinators
--- >>> printDefinitionsWithFreeVariables
--- >>> printAnonymousExpression
View
@@ -1,22 +1,46 @@
-mul = /* 0 *//* mul */ /* 0 */function (v1) { return /* free: ["v1"] */function (v2) { return /* free: ["v1","v2"] */v1 * v2; }; }
-fix = /* 0 *//* fix */ /* 0 */function (v1) { return /* free: ["v1"] */fix = arguments.callee, v1(function (i) { return fix(v1)(i) }); }
-list = /* 0 *//* list */ /* 0 */function (v3) { return /* free: ["v3"] */function (v4) { return /* free: ["v3","v4"] */function (v5) { return /* free: ["v3","v4","v5"] */v5.nil ? v3 : v4(v5.head)(v5.tail); }; }; }
-add = /* 0 *//* add */ /* 0 */function (v5) { return /* free: ["v5"] */function (v6) { return /* free: ["v5","v6"] */v5 + v6; }; }
-fix = /* 0 *//* fix */ /* 0 */function (v1) { return /* free: ["v1"] */fix = arguments.callee, v1(function (i) { return fix(v1)(i) }); }
-list = /* 0 *//* list */ /* 0 */function (v3) { return /* free: ["v3"] */function (v4) { return /* free: ["v3","v4"] */function (v5) { return /* free: ["v3","v4","v5"] */v5.nil ? v3 : v4(v5.head)(v5.tail); }; }; }
-fix = /* 0 *//* fix */ /* 0 */function (v3) { return /* free: ["v3"] */fix = arguments.callee, v3(function (i) { return fix(v3)(i) }); }
-bool = /* 0 *//* bool */ /* 0 */function (v5) { return /* free: ["v5"] */function (v6) { return /* free: ["v5","v6"] */function (v7) { return /* free: ["v5","v6","v7"] */v7 ? v5(/*force*/) : v6(/*force*/); }; }; }
-cons = /* 0 *//* cons */ /* 0 */function (v6) { return /* free: ["v6"] */function (v7) { return /* free: ["v6","v7"] */{ head : v6, tail : v7 }; }; }
-sub = /* 0 *//* sub */ /* 0 */function (v6) { return /* free: ["v6"] */function (v7) { return /* free: ["v6","v7"] */v6 - v7; }; }
-eq = /* 0 *//* eq */ /* 0 */function (v5) { return /* free: ["v5"] */function (v6) { return /* free: ["v5","v6"] */v5 == v6; }; }
-cons = /* 0 *//* cons */ /* 0 */function (v5) { return /* free: ["v5"] */function (v6) { return /* free: ["v5","v6"] */{ head : v5, tail : v6 }; }; }
-fix = /* 0 *//* fix */ /* 0 */function (v1) { return /* free: ["v1"] */fix = arguments.callee, v1(function (i) { return fix(v1)(i) }); }
-bool = /* 0 *//* bool */ /* 0 */function (v3) { return /* free: ["v3"] */function (v4) { return /* free: ["v3","v4"] */function (v5) { return /* free: ["v3","v4","v5"] */v5 ? v3(/*force*/) : v4(/*force*/); }; }; }
-cons = /* 0 *//* cons */ /* 0 */function (v4) { return /* free: ["v4"] */function (v5) { return /* free: ["v4","v5"] */{ head : v4, tail : v5 }; }; }
-sub = /* 0 *//* sub */ /* 0 */function (v4) { return /* free: ["v4"] */function (v5) { return /* free: ["v4","v5"] */v4 - v5; }; }
-eq = /* 0 *//* eq */ /* 0 */function (v3) { return /* free: ["v3"] */function (v4) { return /* free: ["v3","v4"] */v3 == v4; }; }
-maybe = /* 0 *//* maybe */ /* 0 */function (v1) { return /* free: ["v1"] */function (v2) { return /* free: ["v1","v2"] */function (v3) { return /* free: ["v1","v2","v3"] */v3.nothing ? v1 : v2(v3.just); }; }; }
-mul = /* 0 *//* mul */ /* 0 */function (v2) { return /* free: ["v2"] */function (v3) { return /* free: ["v2","v3"] */v2 * v3; }; }
-just = /* 0 *//* just */ /* 0 */function (v1) { return /* free: ["v1"] */{ just : v1 }; }
-sub = /* 0 *//* sub */ /* 0 */function (v1) { return /* free: ["v1"] */function (v2) { return /* free: ["v1","v2"] */v1 - v2; }; }
-__main = /* 0 *//* 0 *//* 0 */mul(/* 0 *//* 0 *//* 0 */fix(/* 0 */function (v1) { return /* free: ["v1"] */function (v2) { return /* free: ["v1","v2"] *//* free: ["v1"] *//* 0 *//* 0 */list(/* 0 */0)(/* free: ["v1"] */function (v3) { return /* free: ["v1","v3"] */function (v4) { return /* free: ["v1","v3","v4"] *//* free: ["v3"] *//* 0 */add(/* free: ["v3"] */v3)(/* free: ["v1","v4"] *//* free: ["v1"] */v1(/* free: ["v4"] */v4)); }; })(/* free: ["v2"] */v2); }; })(/* 0 *//* 0 *//* 0 */fix(/* 0 */function (v1) { return /* free: ["v1"] */function (v2) { return /* free: ["v1","v2"] *//* free: ["v1"] *//* 0 *//* 0 */list(/* 0 *//* 0 *//* 0 */fix(/* 0 */function (v3) { return /* free: ["v3"] */function (v4) { return /* free: ["v3","v4"] *//* free: ["v3","v4"] *//* 0 *//* 0 */bool(/* 0 */function (v5) { return /* free: ["v5"] *//* 0 *//* 0 */function (v6) { return /* free: ["v6"] */function (v7) { return /* free: ["v6"] */v6; }; }(/* 0 */{ nil : 1 })(/* free: ["v5"] */v5); })(/* free: ["v3","v4"] */function (v5) { return /* free: ["v3","v4","v5"] *//* free: ["v3","v4"] *//* 0 */function (v6) { return /* free: ["v6"] */function (v7) { return /* free: ["v6"] */v6; }; }(/* free: ["v3","v4"] *//* 0 *//* 0 */cons(/* 0 */8)(/* free: ["v3","v4"] *//* free: ["v3"] */v3(/* free: ["v4"] *//* free: ["v4"] *//* 0 */sub(/* free: ["v4"] */v4)(/* 0 */1))))(/* free: ["v5"] */v5); })(/* free: ["v4"] *//* free: ["v4"] *//* 0 */eq(/* free: ["v4"] */v4)(/* 0 */0)); }; })(/* 0 */3))(/* free: ["v1"] */function (v3) { return /* free: ["v1","v3"] */function (v4) { return /* free: ["v1","v3","v4"] *//* free: ["v3"] *//* 0 */cons(/* free: ["v3"] */v3)(/* free: ["v1","v4"] *//* free: ["v1"] */v1(/* free: ["v4"] */v4)); }; })(/* free: ["v2"] */v2); }; })(/* 0 *//* 0 *//* 0 */fix(/* 0 */function (v1) { return /* free: ["v1"] */function (v2) { return /* free: ["v1","v2"] *//* free: ["v1","v2"] *//* 0 *//* 0 */bool(/* 0 */function (v3) { return /* free: ["v3"] *//* 0 *//* 0 */function (v4) { return /* free: ["v4"] */function (v5) { return /* free: ["v4"] */v4; }; }(/* 0 */{ nil : 1 })(/* free: ["v3"] */v3); })(/* free: ["v1","v2"] */function (v3) { return /* free: ["v1","v2","v3"] *//* free: ["v1","v2"] *//* 0 */function (v4) { return /* free: ["v4"] */function (v5) { return /* free: ["v4"] */v4; }; }(/* free: ["v1","v2"] *//* 0 *//* 0 */cons(/* 0 */8)(/* free: ["v1","v2"] *//* free: ["v1"] */v1(/* free: ["v2"] *//* free: ["v2"] *//* 0 */sub(/* free: ["v2"] */v2)(/* 0 */1))))(/* free: ["v3"] */v3); })(/* free: ["v2"] *//* free: ["v2"] *//* 0 */eq(/* free: ["v2"] */v2)(/* 0 */0)); }; })(/* 0 */3))))(/* 0 *//* 0 *//* 0 *//* 0 */maybe(/* 0 */4)(/* 0 */function (v1) { return /* free: ["v1"] *//* free: ["v1"] *//* 0 */mul(/* free: ["v1"] */v1)(/* 0 */8); })(/* 0 *//* 0 */just(/* 0 *//* 0 *//* 0 */sub(/* 0 */3)(/* 0 */2))))
+var mul = /* mul */ function (v1) { return function (v2) { return v1 * v2; }; }
+var fix = /* fix */ function (v1) { return fix = arguments.callee, v1(function (i) { return fix(v1)(i) }); }
+var list = /* list */ function (v3) { return function (v4) { return function (v5) { return v5.nil ? v3 : v4(v5.head)(v5.tail); }; }; }
+var add = /* add */ function (v5) { return function (v6) { return v5 + v6; }; }
+var fix = /* fix */ function (v1) { return fix = arguments.callee, v1(function (i) { return fix(v1)(i) }); }
+var list = /* list */ function (v3) { return function (v4) { return function (v5) { return v5.nil ? v3 : v4(v5.head)(v5.tail); }; }; }
+var fix = /* fix */ function (v3) { return fix = arguments.callee, v3(function (i) { return fix(v3)(i) }); }
+var bool = /* bool */ function (v5) { return function (v6) { return function (v7) { return v7 ? v5(/*force*/) : v6(/*force*/); }; }; }
+var cons = /* cons */ function (v6) { return function (v7) { return { head : v6, tail : v7 }; }; }
+var sub = /* sub */ function (v6) { return function (v7) { return v6 - v7; }; }
+var eq = /* eq */ function (v5) { return function (v6) { return v5 == v6; }; }
+var cons = /* cons */ function (v5) { return function (v6) { return { head : v5, tail : v6 }; }; }
+var fix = /* fix */ function (v1) { return fix = arguments.callee, v1(function (i) { return fix(v1)(i) }); }
+var bool = /* bool */ function (v3) { return function (v4) { return function (v5) { return v5 ? v3(/*force*/) : v4(/*force*/); }; }; }
+var cons = /* cons */ function (v4) { return function (v5) { return { head : v4, tail : v5 }; }; }
+var sub = /* sub */ function (v4) { return function (v5) { return v4 - v5; }; }
+var eq = /* eq */ function (v3) { return function (v4) { return v3 == v4; }; }
+var maybe = /* maybe */ function (v1) { return function (v2) { return function (v3) { return v3.nothing ? v1 : v2(v3.just); }; }; }
+var mul = /* mul */ function (v2) { return function (v3) { return v2 * v3; }; }
+var just = /* just */ function (v1) { return { just : v1 }; }
+var sub = /* sub */ function (v1) { return function (v2) { return v1 - v2; }; }
+var c1 = list(0)
+var c2 = fix(function (v1) { return function (v2) { return c1(function (v3) { return function (v4) { return add(v3)(v1(v4)); }; })(v2); }; })
+var c3 = function (v6) { return function (v7) { return v6; }; }({ nil : 1 })
+var c4 = bool(function (v5) { return c3(v5); })
+var c5 = cons(8)
+var c6 = fix(function (v3) { return function (v4) { return c4(function (v5) { return function (v6) { return function (v7) { return v6; }; }(c5(v3(sub(v4)(1))))(v5); })(eq(v4)(0)); }; })
+var c7 = c6(3)
+var c8 = list(c7)
+var c9 = fix(function (v1) { return function (v2) { return c8(function (v3) { return function (v4) { return cons(v3)(v1(v4)); }; })(v2); }; })
+var c10 = function (v4) { return function (v5) { return v4; }; }({ nil : 1 })
+var c11 = bool(function (v3) { return c10(v3); })
+var c12 = cons(8)
+var c13 = fix(function (v1) { return function (v2) { return c11(function (v3) { return function (v4) { return function (v5) { return v4; }; }(c12(v1(sub(v2)(1))))(v3); })(eq(v2)(0)); }; })
+var c14 = c13(3)
+var c15 = c9(c14)
+var c16 = c2(c15)
+var c17 = mul(c16)
+var c18 = maybe(4)
+var c19 = c18(function (v1) { return mul(v1)(8); })
+var c20 = sub(3)
+var c21 = c20(2)
+var c22 = just(c21)
+var c23 = c19(c22)
+var c24 = c17(c23)
+var __main = c24

0 comments on commit a04e831

Please sign in to comment.