git.iko.soy/elk
on master help sign in
Use Var.Global in optimized AST
12fbd47Evan Czaplicki
src/AST/Expression/Optimized.hs+7−7
compare with master
unifiedsplit
@@ -8,7 +8,7 @@ module AST.Expression.Optimized
8 where
8 where
9
9
10
10
11−import Control.Monad (liftM, liftM2, liftM3, liftM4)
11+import Control.Monad (liftM, liftM2, liftM3)
12import Data.Binary
12import Data.Binary
13import qualified Data.Set as Set
13import qualified Data.Set as Set
14import Data.Text (Text)
14import Data.Text (Text)
@@ -51,9 +51,9 @@ data Def
51data Expr
51data Expr
52 = Literal Literal.Literal
52 = Literal Literal.Literal
53 | VarLocal Text
53 | VarLocal Text
54− | VarGlobal ModuleName.Canonical Text
54+ | VarGlobal Var.Global
55 | List [Expr]
55 | List [Expr]
56− | Binop ModuleName.Canonical Text Expr Expr
56+ | Binop Var.Global Expr Expr
57 | Function [Text] Expr
57 | Function [Text] Expr
58 | Call Expr [Expr]
58 | Call Expr [Expr]
59 | TailCall Text [Text] [Expr]
59 | TailCall Text [Text] [Expr]
@@ -129,9 +129,9 @@ instance Binary Expr where
129 case word of
129 case word of
130 0 -> liftM Literal get
130 0 -> liftM Literal get
131 1 -> liftM VarLocal get
131 1 -> liftM VarLocal get
132− 2 -> liftM2 VarGlobal get get
132+ 2 -> liftM VarGlobal get
133 3 -> liftM List get
133 3 -> liftM List get
134− 4 -> liftM4 Binop get get get get
134+ 4 -> liftM3 Binop get get get
135 5 -> liftM2 Function get get
135 5 -> liftM2 Function get get
136 6 -> liftM2 Call get get
136 6 -> liftM2 Call get get
137 7 -> liftM3 TailCall get get get
137 7 -> liftM3 TailCall get get get
@@ -156,9 +156,9 @@ instance Binary Expr where
156 case expr of
156 case expr of
157 Literal a -> putWord8 0 >> put a
157 Literal a -> putWord8 0 >> put a
158 VarLocal a -> putWord8 1 >> put a
158 VarLocal a -> putWord8 1 >> put a
159− VarGlobal a b -> putWord8 2 >> put a >> put b
159+ VarGlobal a -> putWord8 2 >> put a
160 List a -> putWord8 3 >> put a
160 List a -> putWord8 3 >> put a
161− Binop a b c d -> putWord8 4 >> put a >> put b >> put c >> put d
161+ Binop a b c -> putWord8 4 >> put a >> put b >> put c
162 Function a b -> putWord8 5 >> put a >> put b
162 Function a b -> putWord8 5 >> put a >> put b
163 Call a b -> putWord8 6 >> put a >> put b
163 Call a b -> putWord8 6 >> put a >> put b
164 TailCall a b c -> putWord8 7 >> put a >> put b >> put c
164 TailCall a b c -> putWord8 7 >> put a >> put b >> put c
src/Generate/JavaScript/Expression.hs+12−12
@@ -109,8 +109,8 @@ generateCode expr =
109 VarLocal name ->
109 VarLocal name ->
110 jsExpr $ Var.local name
110 jsExpr $ Var.local name
111
111
112− VarGlobal home name ->
112+ VarGlobal name ->
113− jsExpr $ Var.global home name
113+ jsExpr $ Var.global name
114
114
115 Literal lit ->
115 Literal lit ->
116 jsExpr (Literal.literal lit)
116 jsExpr (Literal.literal lit)
@@ -138,8 +138,8 @@ generateCode expr =
138 do jsFields <- mapM toField fields
138 do jsFields <- mapM toField fields
139 jsExpr $ JS.Object jsFields
139 jsExpr $ JS.Object jsFields
140
140
141− Binop home op leftExpr rightExpr ->
141+ Binop op leftExpr rightExpr ->
142− generateBinop home op leftExpr rightExpr
142+ generateBinop op leftExpr rightExpr
143
143
144 Function args body ->
144 Function args body ->
145 generateFunction args body
145 generateFunction args body
@@ -300,13 +300,13 @@ generateFunctionWithArity rawArgs code =
300generateCall :: Opt.Expr -> [Opt.Expr] -> State Int Code
300generateCall :: Opt.Expr -> [Opt.Expr] -> State Int Code
301generateCall func args =
301generateCall func args =
302 case (func, args) of
302 case (func, args) of
303− (Opt.VarGlobal home name, [arg]) ->
303+ (Opt.VarGlobal (V.Global home name), [arg]) ->
304 case name of
304 case name of
305 "complement" | home == bitwise -> genPrefix JS.PrefixBNot arg
305 "complement" | home == bitwise -> genPrefix JS.PrefixBNot arg
306 "not" | home == basics -> genPrefix JS.PrefixLNot arg
306 "not" | home == basics -> genPrefix JS.PrefixLNot arg
307 _ -> generateCallHelp func args
307 _ -> generateCallHelp func args
308
308
309− (Opt.VarGlobal home name, [ left, right ]) | home == bitwise ->
309+ (Opt.VarGlobal (V.Global home name), [ left, right ]) | home == bitwise ->
310 case name of
310 case name of
311 "and" -> genInfix JS.OpBAnd left right
311 "and" -> genInfix JS.OpBAnd left right
312 "or" -> genInfix JS.OpBOr left right
312 "or" -> genInfix JS.OpBOr left right
@@ -540,22 +540,22 @@ pathToExpr root fullPath =
540-- BINARY OPERATORS
540-- BINARY OPERATORS
541
541
542
542
543−generateBinop :: ModuleName.Canonical -> Text -> Opt.Expr -> Opt.Expr -> State Int Code
543+generateBinop :: V.Global -> Opt.Expr -> Opt.Expr -> State Int Code
544−generateBinop home op left right =
544+generateBinop op left right =
545 do jsLeft <- generateJsExpr left
545 do jsLeft <- generateJsExpr left
546 jsRight <- generateJsExpr right
546 jsRight <- generateJsExpr right
547− jsExpr (generateBinopHelp home op jsLeft jsRight)
547+ jsExpr (generateBinopHelp op jsLeft jsRight)
548
548
549
549
550
550
551-- BINARY OPERATOR HELPERS
551-- BINARY OPERATOR HELPERS
552
552
553
553
554−generateBinopHelp :: ModuleName.Canonical -> Text -> JS.Expr -> JS.Expr -> JS.Expr
554+generateBinopHelp :: V.Global -> JS.Expr -> JS.Expr -> JS.Expr
555−generateBinopHelp home op leftExpr rightExpr =
555+generateBinopHelp var@(V.Global home op) leftExpr rightExpr =
556 let
556 let
557 simpleMake left right =
557 simpleMake left right =
558− JS.Call (ref "A2") [ Var.global home op, left, right ]
558+ JS.Call (ref "A2") [ Var.global var, left, right ]
559 in
559 in
560 if home == basics then
560 if home == basics then
561 (Map.findWithDefault simpleMake op basicOps) leftExpr rightExpr
561 (Map.findWithDefault simpleMake op basicOps) leftExpr rightExpr
src/Generate/JavaScript/Foreign.hs+2−2
@@ -155,7 +155,7 @@ decode tipe =
155
155
156to :: Text -> Opt.Expr
156to :: Text -> Opt.Expr
157to name =
157to name =
158− Opt.VarGlobal jsonDecode name
158+ Opt.VarGlobal (Var.Global jsonDecode name)
159
159
160
160
161jsonDecode :: ModuleName.Canonical
161jsonDecode :: ModuleName.Canonical
@@ -186,7 +186,7 @@ toMaybe :: T.Canonical -> Opt.Expr
186toMaybe tipe =
186toMaybe tipe =
187 let
187 let
188 maybe tag =
188 maybe tag =
189− Opt.VarGlobal (ModuleName.inCore "Maybe") tag
189+ Opt.VarGlobal (Var.Global (ModuleName.inCore "Maybe") tag)
190 in
190 in
191 to "oneOf" <==
191 to "oneOf" <==
192 [ Opt.List
192 [ Opt.List
src/Generate/JavaScript/Variable.hs+5−4
@@ -20,6 +20,7 @@ import Data.Text (Text)
20
20
21import qualified AST.Helpers as Help
21import qualified AST.Helpers as Help
22import qualified AST.Module.Name as ModuleName
22import qualified AST.Module.Name as ModuleName
23+import qualified AST.Variable as Var
23import qualified Elm.Package as Pkg
24import qualified Elm.Package as Pkg
24import qualified Generate.JavaScript.Builder as JS
25import qualified Generate.JavaScript.Builder as JS
25import qualified Generate.JavaScript.Helpers as JS
26import qualified Generate.JavaScript.Helpers as JS
@@ -45,8 +46,8 @@ local name =
45 JS.ref (safe name)
46 JS.ref (safe name)
46
47
47
48
48−global :: ModuleName.Canonical -> Text -> JS.Expr
49+global :: Var.Global -> JS.Expr
49−global home name =
50+global (Var.Global home name) =
50 if Help.isOp name then
51 if Help.isOp name then
51 JS.BracketRef (JS.ref (opsDict home)) (JS.String name)
52 JS.BracketRef (JS.ref (opsDict home)) (JS.String name)
52 else
53 else
@@ -59,12 +60,12 @@ global home name =
59
60
60coreNative :: Text -> Text -> JS.Expr
61coreNative :: Text -> Text -> JS.Expr
61coreNative moduleName name =
62coreNative moduleName name =
62− global (ModuleName.inCore ("Native." <> moduleName)) name
63+ global (Var.Global (ModuleName.inCore ("Native." <> moduleName)) name)
63
64
64
65
65staticProgram :: JS.Expr
66staticProgram :: JS.Expr
66staticProgram =
67staticProgram =
67− global (ModuleName.inVirtualDom "Native.VirtualDom") "staticProgram"
68+ global (Var.Global (ModuleName.inVirtualDom "Native.VirtualDom") "staticProgram")
68
69
69
70
70
71
src/Optimize.hs+11−8
@@ -50,12 +50,13 @@ optimizeDecl variantDict home index (Can.Def _ pattern@(A.A _ ptrn) expression _
50 (_, []) ->
50 (_, []) ->
51 let
51 let
52 name = "_" <> Text.pack (show index)
52 name = "_" <> Text.pack (show index)
53− deps = Set.singleton (Var.Global home name)
53+ var = Var.Global home name
54+ deps = Set.singleton var
54 decl =
55 decl =
55 Env.run variantDict home $
56 Env.run variantDict home $
56 ((,) name . Opt.Def) <$> optimizeExpr Nothing rawBody
57 ((,) name . Opt.Def) <$> optimizeExpr Nothing rawBody
57 destructors =
58 destructors =
58− destruct (Opt.VarGlobal home name) pattern
59+ destruct (Opt.VarGlobal var) pattern
59 in
60 in
60 decl : map (second (Opt.Decl deps Nothing)) destructors
61 decl : map (second (Opt.Decl deps Nothing)) destructors
61
62
@@ -309,17 +310,19 @@ optimizeVariable region (Var.Canonical home name) =
309 pure (Opt.VarLocal name)
310 pure (Opt.VarLocal name)
310
311
311 Var.TopLevel modul ->
312 Var.TopLevel modul ->
313+ do let var = Var.Global modul name
312− do Env.register (Var.Global modul name)
314+ Env.register var
313− pure (Opt.VarGlobal modul name)
315+ pure (Opt.VarGlobal var)
314
316
315 Var.Module modul ->
317 Var.Module modul ->
316− do Env.register (Var.Global modul name)
318+ do let var = Var.Global modul name
319+ Env.register var
317 if name == "crash" && modul == ModuleName.inCore "Debug"
320 if name == "crash" && modul == ModuleName.inCore "Debug"
318 then
321 then
319 do here <- Env.getHome
322 do here <- Env.getHome
320 pure (Opt.Crash here region Nothing)
323 pure (Opt.Crash here region Nothing)
321 else
324 else
322− pure (Opt.VarGlobal modul name)
325+ pure (Opt.VarGlobal var)
323
326
324
327
325
328
@@ -541,7 +544,7 @@ makeOptBinop (Var.Canonical home op) leftExpr rightExpr =
541 error "bug manifesting in Optimize.makeOptBinop"
544 error "bug manifesting in Optimize.makeOptBinop"
542
545
543 Var.Module name ->
546 Var.Module name ->
544− Opt.Binop name op leftExpr rightExpr
547+ Opt.Binop (Var.Global name op) leftExpr rightExpr
545
548
546 Var.TopLevel name ->
549 Var.TopLevel name ->
547− Opt.Binop name op leftExpr rightExpr
550+ Opt.Binop (Var.Global name op) leftExpr rightExpr
src/Optimize/Inline.hs+5−5
@@ -81,13 +81,13 @@ count expression =
81 VarLocal name ->
81 VarLocal name ->
82 Map.singleton name 1
82 Map.singleton name 1
83
83
84− VarGlobal _ _ ->
84+ VarGlobal _ ->
85 Map.empty
85 Map.empty
86
86
87 List exprs ->
87 List exprs ->
88 countMany exprs
88 countMany exprs
89
89
90− Binop _ _ left right ->
90+ Binop _ left right ->
91 count2 left right
91 count2 left right
92
92
93 Function args body ->
93 Function args body ->
@@ -188,14 +188,14 @@ replace substitutions expression =
188 VarLocal name ->
188 VarLocal name ->
189 maybe expression id (Map.lookup name substitutions)
189 maybe expression id (Map.lookup name substitutions)
190
190
191− VarGlobal _ _ ->
191+ VarGlobal _ ->
192 expression
192 expression
193
193
194 List exprs ->
194 List exprs ->
195 List (map go exprs)
195 List (map go exprs)
196
196
197− Binop home op left right ->
197+ Binop op left right ->
198− Binop home op (go left) (go right)
198+ Binop op (go left) (go right)
199
199
200 Function args body ->
200 Function args body ->
201 Function args (replace (deleteBatch args substitutions) body)
201 Function args (replace (deleteBatch args substitutions) body)