on master help sign in
Resolve infinite loops for ports, fix #653
8d69600Evan Czaplicki
compiler/Generate/JavaScript.hs+2−3
@@ -37,7 +37,6 @@ internalImports name =
37 , include "_L" "List"
37 , include "_L" "List"
38 , include "_A" "Array"
38 , include "_A" "Array"
39 , include "_E" "Error"
39 , include "_E" "Error"
40− , include "_P" "Ports"
41 , varDecl Help.localModuleName (string name)
40 , varDecl Help.localModuleName (string name)
42 ]
41 ]
43 where
42 where
@@ -193,11 +192,11 @@ expression (A region expr) =
193 return $ ObjectLit () [(PropString () "src", literal (Str src))]
192 return $ ObjectLit () [(PropString () "src", literal (Str src))]
194
193
195 PortIn name tipe ->
194 PortIn name tipe ->
196− return $ obj ["_P","portIn"] `call` [ string name, Port.incoming tipe ]
195+ return $ Var.nativePorts "portIn" `call` [ string name, Port.incoming tipe ]
197
196
198 PortOut name tipe value ->
197 PortOut name tipe value ->
199 do value' <- expression value
198 do value' <- expression value
200− return $ obj ["_P","portOut"] `call`
199+ return $ Var.nativePorts "portOut" `call`
201 [ string name, Port.outgoing tipe, value' ]
200 [ string name, Port.outgoing tipe, value' ]
202
201
203definition :: Canonical.Def -> State Int [Statement ()]
202definition :: Canonical.Def -> State Int [Statement ()]
compiler/Generate/JavaScript/Ports.hs+5−10
@@ -2,10 +2,10 @@
2module Generate.JavaScript.Ports (incoming, outgoing) where
2module Generate.JavaScript.Ports (incoming, outgoing) where
3
3
4import Generate.JavaScript.Helpers
4import Generate.JavaScript.Helpers
5+import Generate.JavaScript.Variable (nativePorts, nativeJson)
5import AST.Type as T
6import AST.Type as T
6import qualified AST.Variable as Var
7import qualified AST.Variable as Var
7import Language.ECMAScript3.Syntax
8import Language.ECMAScript3.Syntax
8−import Generate.JavaScript.Variable (canonical)
9
9
10data JSType = JSNumber | JSBoolean | JSString | JSArray | JSObject [String]
10data JSType = JSNumber | JSBoolean | JSString | JSArray | JSObject [String]
11 deriving Show
11 deriving Show
@@ -30,7 +30,7 @@ incoming tipe =
30 Aliased _ t -> incoming t
30 Aliased _ t -> incoming t
31
31
32 App (Type v) [t]
32 App (Type v) [t]
33− | Var.isSignal v -> obj ["_P","incomingSignal"] <| incoming t
33+ | Var.isSignal v -> nativePorts "incomingSignal" <| incoming t
34
34
35 _ -> ["v"] ==> inc tipe (ref "v")
35 _ -> ["v"] ==> inc tipe (ref "v")
36
36
@@ -51,11 +51,8 @@ inc tipe x =
51 from checks = check x checks x
51 from checks = check x checks x
52
52
53 Type name
53 Type name
54− | Var.isJson name -> canonical fromJS <| x
54+ | Var.isJson name -> nativeJson "fromJS" <| x
55 | otherwise -> error "bad type got to incoming port generation code"
55 | otherwise -> error "bad type got to incoming port generation code"
56− where
57− fromJS = Var.Canonical (Var.Module "Native.Json") "fromJS"
58−
59
56
60 App f args ->
57 App f args ->
61 case f : args of
58 case f : args of
@@ -100,7 +97,7 @@ outgoing tipe =
100 Aliased _ t -> outgoing t
97 Aliased _ t -> outgoing t
101
98
102 App (Type v) [t]
99 App (Type v) [t]
103− | Var.isSignal v -> obj ["_P","outgoingSignal"] <| outgoing t
100+ | Var.isSignal v -> nativePorts "outgoingSignal" <| outgoing t
104
101
105 _ -> ["v"] ==> out tipe (ref "v")
102 _ -> ["v"] ==> out tipe (ref "v")
106
103
@@ -129,10 +126,8 @@ out tipe x =
129 | name `elem` ["Int","Float","Bool","String"] -> x
126 | name `elem` ["Int","Float","Bool","String"] -> x
130
127
131 Type name
128 Type name
132− | Var.isJson name -> canonical toJS <| x
129+ | Var.isJson name -> nativeJson "toJS" <| x
133 | otherwise -> error "bad type got to outgoing port generation code"
130 | otherwise -> error "bad type got to outgoing port generation code"
134− where
135− toJS = Var.Canonical (Var.Module "Native.Json") "toJS"
136
131
137 App f args ->
132 App f args ->
138 case f : args of
133 case f : args of
compiler/Generate/JavaScript/Variable.hs+8
@@ -30,6 +30,14 @@ varName x = map (swap '\'' '$') x'
30 where
30 where
31 x' = if Set.member x jsReserveds then '$' : x else x
31 x' = if Set.member x jsReserveds then '$' : x else x
32
32
33+nativeJson :: String -> JS.Expression ()
34+nativeJson value =
35+ canonical (Var.Canonical (Var.Module "Native.Json") value)
36+
37+nativePorts :: String -> JS.Expression ()
38+nativePorts value =
39+ canonical (Var.Canonical (Var.Module "Native.Ports") value)
40+
33jsReserveds :: Set.Set String
41jsReserveds :: Set.Set String
34jsReserveds = Set.fromList
42jsReserveds = Set.fromList
35 [ "null", "undefined", "Nan", "Infinity", "true", "false", "eval"
43 [ "null", "undefined", "Nan", "Infinity", "true", "false", "eval"
compiler/Transform/Canonicalize.hs+2−1
@@ -38,7 +38,8 @@ module' interfaces modul =
38 runState (runErrorT (moduleHelp interfaces modul)) Set.empty
38 runState (runErrorT (moduleHelp interfaces modul)) Set.empty
39
39
40 filterImports m =
40 filterImports m =
41+ let usedModules' = Set.insert "Native.Ports" usedModules
41− let used (name,_) = Set.member name usedModules
42+ used (name,_) = Set.member name usedModules'
42 in m { Module.imports = filter used (Module.imports m) }
43 in m { Module.imports = filter used (Module.imports m) }
43
44
44moduleHelp :: Module.Interfaces -> Module.ValidModule
45moduleHelp :: Module.Interfaces -> Module.ValidModule