git.iko.soy/elk
on master help sign in
Refactor input/output JS generation
f21c35bEvan Czaplicki
src/Generate/JavaScript.hs+14−8
compare with master
unifiedsplit
@@ -204,14 +204,20 @@ expression (A region expr) =
204 GLShader _uid src _tipe ->
204 GLShader _uid src _tipe ->
205 return $ ObjectLit () [(PropString () "src", literal (Str src))]
205 return $ ObjectLit () [(PropString () "src", literal (Str src))]
206
206
207− PortIn name tipe ->
207+ Input name tipe ->
208− return $ obj ["_P","portIn"] `call`
208+ return (Foreign.input name tipe)
209− [ string name, Foreign.incoming tipe ]
209+
210−
211− PortOut name tipe value ->
210+ Output name tipe value ->
212− do value' <- expression value
211+ do value' <- expression value
213− return $ obj ["_P","portOut"] `call`
212+ return (Foreign.output name tipe value')
214− [ string name, Foreign.outgoing tipe, value' ]
213+
214+ Loopback name tipe maybeExpr ->
215+ case maybeExpr of
216+ Nothing ->
217+ error "create writable stream"
218+
219+ Just expr ->
220+ error "run the promises"
215
221
216
222
217definition :: Canonical.Def -> State Int [Statement ()]
223definition :: Canonical.Def -> State Int [Statement ()]
src/Generate/JavaScript/Foreign.hs+82−64
@@ -1,4 +1,4 @@
1−module Generate.JavaScript.Foreign (incoming, outgoing) where
1+module Generate.JavaScript.Foreign (input, output) where
2
2
3import qualified Data.List as List
3import qualified Data.List as List
4import Generate.JavaScript.Helpers
4import Generate.JavaScript.Helpers
@@ -57,28 +57,42 @@ check x jsType continue =
57 JSBoolean -> [typeof "boolean"]
57 JSBoolean -> [typeof "boolean"]
58 JSString -> [typeof "string", instanceof "String"]
58 JSString -> [typeof "string", instanceof "String"]
59 JSArray -> [instanceof "Array"]
59 JSArray -> [instanceof "Array"]
60+ JSObject fields ->
60− JSObject fields -> [jsFold OpLAnd (typeof "object" : map member fields)]
61+ [jsFold OpLAnd (typeof "object" : map member fields)]
61
62
62
63
64+-- INPUT
65+
63−incoming :: CanonicalType -> Expression ()
66+input :: String -> CanonicalType -> Expression ()
64−incoming tipe =
67+input name tipe =
65− case tipe of
68+ case T.dealias tipe of
66− Aliased _ t -> incoming t
69+ App (Type signal) [t]
70+ | Var.isStream signal ->
71+ obj ["_P","inputStream"] <| toTypeFunction t
72+
73+ | Var.isVarying signal ->
74+ obj ["_P","inputVarying"] <| toTypeFunction t
75+
76+ dealiasedType ->
77+ obj ["_P","inputValue"] <| toTypeFunction dealiasedType
67
78
68− App (Type v) [t]
69− | Var.isSignal v ->
70− obj ["_P","incomingSignal"] <| incoming t
71
79
80+toTypeFunction :: CanonicalType -> Expression ()
81+toTypeFunction tipe =
72− _ -> ["v"] ==> inc tipe (ref "v")
82+ ["v"] ==> toType tipe (ref "v")
73
83
74
84
75−inc :: CanonicalType -> Expression () -> Expression ()
85+toType :: CanonicalType -> Expression () -> Expression ()
76−inc tipe x =
86+toType tipe x =
77 case tipe of
87 case tipe of
88+ Lambda _ _ ->
78− Lambda _ _ -> error "functions should not be allowed through input ports"
89+ error "functions should not be allowed through input ports"
90+
91+ Var _ ->
79− Var _ -> error "type variables should not be allowed through input ports"
92+ error "type variables should not be allowed through input ports"
93+
80 Aliased _ t ->
94 Aliased _ t ->
81− inc t x
95+ toType t x
82
96
83 Type (Var.Canonical Var.BuiltIn name)
97 Type (Var.Canonical Var.BuiltIn name)
84 | name == "Int" -> from JSNumber
98 | name == "Int" -> from JSNumber
@@ -93,10 +107,10 @@ inc tipe x =
93 x
107 x
94
108
95 | Var.isTuple name ->
109 | Var.isTuple name ->
96− incomingTuple [] x
110+ toTuple [] x
97
111
98 | otherwise ->
112 | otherwise ->
99− error "bad type got to incoming port generation code"
113+ error "bad type got to foreign input conversion"
100
114
101 App f args ->
115 App f args ->
102 case f : args of
116 case f : args of
@@ -105,7 +119,7 @@ inc tipe x =
105 CondExpr ()
119 CondExpr ()
106 (equal x (NullLit ()))
120 (equal x (NullLit ()))
107 (_Maybe "Nothing")
121 (_Maybe "Nothing")
108− (_Maybe "Just" <| inc t x)
122+ (_Maybe "Just" <| toType t x)
109
123
110 | Var.isList name ->
124 | Var.isList name ->
111 check x JSArray (_List "fromArray" <| array)
125 check x JSArray (_List "fromArray" <| array)
@@ -113,92 +127,95 @@ inc tipe x =
113 | Var.isArray name ->
127 | Var.isArray name ->
114 check x JSArray (_Array "fromJSArray" <| array)
128 check x JSArray (_Array "fromJSArray" <| array)
115 where
129 where
116− array = DotRef () x (var "map") <| incoming t
130+ array = DotRef () x (var "map") <| toTypeFunction t
117
131
118 Type name : ts
132 Type name : ts
119− | Var.isTuple name -> incomingTuple ts x
133+ | Var.isTuple name ->
134+ toTuple ts x
120
135
121− _ -> error "bad ADT got to incoming port generation code"
136+ _ -> error "bad ADT got to foreign input conversion"
122
137
123 Record _ (Just _) ->
138 Record _ (Just _) ->
124− error "bad record got to incoming port generation code"
139+ error "bad record got to foreign input conversion"
125
140
126 Record fields Nothing ->
141 Record fields Nothing ->
127 check x (JSObject (map fst fields)) object
142 check x (JSObject (map fst fields)) object
128 where
143 where
129 object = ObjectLit () $ (prop "_", ObjectLit () []) : keys
144 object = ObjectLit () $ (prop "_", ObjectLit () []) : keys
130 keys = map convert fields
145 keys = map convert fields
131− convert (f,t) = (prop f, inc t (DotRef () x (var f)))
146+ convert (f,t) = (prop f, toType t (DotRef () x (var f)))
132
147
133
148
134−incomingTuple :: [CanonicalType] -> Expression () -> Expression ()
149+toTuple :: [CanonicalType] -> Expression () -> Expression ()
135−incomingTuple types x =
150+toTuple types x =
136 check x JSArray (ObjectLit () fields)
151 check x JSArray (ObjectLit () fields)
137 where
152 where
153+ fields =
138− fields = (prop "ctor", ctor) : zipWith convert [0..] types
154+ (prop "ctor", ctor) : zipWith convert [0..] types
139
155
156+ ctor =
140− ctor = string ("_Tuple" ++ show (length types))
157+ string ("_Tuple" ++ show (length types))
141
158
142 convert n t =
159 convert n t =
143 ( prop ('_':show n)
160 ( prop ('_':show n)
144− , inc t (BracketRef () x (IntLit () n))
161+ , toType t (BracketRef () x (IntLit () n))
145 )
162 )
146
163
147
164
148−outgoing :: CanonicalType -> Expression ()
165+-- OUTPUT
149−outgoing tipe =
150− case T.dealias tipe of
151− App (Type signal) [ App (Type promise) [_,_] ]
152− | Var.isSignal signal && Var.isPromise promise ->
153− obj ["_P","promiseStream"]
154
166
167+output :: String -> CanonicalType -> Expression () -> Expression ()
168+output name tipe value =
169+ case T.dealias tipe of
155− App (Type promise) [_,_]
170+ App (Type signal) [t]
156− | Var.isPromise promise ->
171+ | Var.isStream signal ->
157− obj ["_P","promise"]
172+ obj ["_P","outputStream"] `call` [ fromTypeFunction t, value ]
158
173
159− _ ->
174+ | Var.isVarying signal ->
160− outgoingFunc tipe
175+ obj ["_P","outputVarying"] `call` [ fromTypeFunction t, value ]
161
176
177+ dealiasedType ->
178+ obj ["_P","outputValue"] `call` [ fromTypeFunction dealiasedType, value ]
162
179
163−outgoingFunc :: CanonicalType -> Expression ()
164−outgoingFunc tipe =
165− case tipe of
166− App (Type v) [t]
167− | Var.isSignal v ->
168− obj ["_P","outgoingSignal"] <| outgoingFunc t
169
180
181+fromTypeFunction :: CanonicalType -> Expression ()
182+fromTypeFunction tipe =
170− _ -> ["v"] ==> out tipe (ref "v")
183+ ["v"] ==> fromType tipe (ref "v")
171
184
172
185
173−out :: CanonicalType -> Expression () -> Expression ()
186+fromType :: CanonicalType -> Expression () -> Expression ()
174−out tipe x =
187+fromType tipe x =
175 case tipe of
188 case tipe of
176− Aliased _ t -> out t x
189+ Aliased _ t ->
190+ fromType t x
177
191
178 Lambda _ _
192 Lambda _ _
179 | numArgs > 1 && numArgs < 10 ->
193 | numArgs > 1 && numArgs < 10 ->
180 func (ref ('A':show numArgs) `call` (x:values))
194 func (ref ('A':show numArgs) `call` (x:values))
195+ | otherwise ->
181− | otherwise -> func (foldl (<|) x values)
196+ func (foldl (<|) x values)
182 where
197 where
183 ts = T.collectLambdas tipe
198 ts = T.collectLambdas tipe
184 numArgs = length ts - 1
199 numArgs = length ts - 1
185 args = map (\n -> '_' : show n) [0..]
200 args = map (\n -> '_' : show n) [0..]
186− values = zipWith inc (init ts) (map ref args)
201+ values = zipWith toType (init ts) (map ref args)
187 func body =
202 func body =
188 function (take numArgs args)
203 function (take numArgs args)
189 [ VarDeclStmt () [VarDecl () (var "_r") (Just body)]
204 [ VarDeclStmt () [VarDecl () (var "_r") (Just body)]
190− , ret (out (last ts) (ref "_r"))
205+ , ret (fromType (last ts) (ref "_r"))
191 ]
206 ]
192
207
208+ Var _ ->
193− Var _ -> error "type variables should not be allowed through input ports"
209+ error "type variables should not be allowed through outputs"
194
210
195 Type (Var.Canonical Var.BuiltIn name)
211 Type (Var.Canonical Var.BuiltIn name)
196− | name `elem` ["Int","Float","Bool","String"] -> x
212+ | name `elem` ["Int","Float","Bool","String"] ->
213+ x
197
214
198 Type name
215 Type name
199 | Var.isJson name -> x
216 | Var.isJson name -> x
200 | Var.isTuple name -> ArrayLit () []
217 | Var.isTuple name -> ArrayLit () []
201− | otherwise -> error "bad type got to outgoing port generation code"
218+ | otherwise -> error "bad type got to an output"
202
219
203 App f args ->
220 App f args ->
204 case f : args of
221 case f : args of
@@ -207,26 +224,27 @@ out tipe x =
207 CondExpr ()
224 CondExpr ()
208 (equal (DotRef () x (var "ctor")) (string "Nothing"))
225 (equal (DotRef () x (var "ctor")) (string "Nothing"))
209 (NullLit ())
226 (NullLit ())
210− (out t (DotRef () x (var "_0")))
227+ (fromType t (DotRef () x (var "_0")))
211
228
212 | Var.isArray name ->
229 | Var.isArray name ->
213− DotRef () (_Array "toJSArray" <| x) (var "map") <| outgoingFunc t
230+ DotRef () (_Array "toJSArray" <| x) (var "map") <| fromTypeFunction t
214
231
215 | Var.isList name ->
232 | Var.isList name ->
216− DotRef () (_List "toArray" <| x) (var "map") <| outgoingFunc t
233+ DotRef () (_List "toArray" <| x) (var "map") <| fromTypeFunction t
217
234
218 Type name : ts
235 Type name : ts
219 | Var.isTuple name ->
236 | Var.isTuple name ->
220− let convert n t = out t $ DotRef () x $ var ('_':show n)
237+ let convert n t = fromType t $ DotRef () x $ var ('_':show n)
221 in ArrayLit () $ zipWith convert [0..] ts
238 in ArrayLit () $ zipWith convert [0..] ts
222
239
223− _ -> error "bad ADT got to outgoing port generation code"
240+ _ -> error "bad ADT got to an output"
224
241
225 Record _ (Just _) ->
242 Record _ (Just _) ->
226− error "bad record got to outgoing port generation code"
243+ error "bad record got to an output"
227
244
228 Record fields Nothing ->
245 Record fields Nothing ->
229 ObjectLit () keys
246 ObjectLit () keys
230− where
247+ where
231− keys = map convert fields
248+ keys = map convert fields
249+ convert (f,t) =
232− convert (f,t) = (PropId () (var f), out t (DotRef () x (var f)))
250+ (PropId () (var f), fromType t (DotRef () x (var f)))