@@ -3,7 +3,7 @@ module Generate.JavaScript.Ports (incoming, outgoing) where
33
44import Generate.JavaScript.Helpers
55import qualified SourceSyntax.Helpers as Help
6−import SourceSyntax.Type
6+import SourceSyntax.Type as T
77import Language.ECMAScript3.Syntax
88
99data JSType = JSNumber | JSBoolean | JSString | JSArray | JSObject [String]
@@ -28,10 +28,10 @@ incoming tipe =
2828 case tipe of
2929 Data "Signal.Signal" [t] ->
3030 obj "Native.Ports.incomingSignal" <| incoming t
31− _ -> ["v"] ==> go tipe (ref "v")
32− where
33− go :: Type -> Expression () -> Expression ()
34− go tipe x =
31+ _ -> ["v"] ==> inc tipe (ref "v")
32+
33+inc :: Type -> Expression () -> Expression ()
34+inc tipe x =
3535 case tipe of
3636 Lambda _ _ -> error "functions should not be allowed through input ports"
3737 Var _ -> error "type variables should not be allowed through input ports"
@@ -51,7 +51,7 @@ incoming tipe =
5151 | ctor == "Maybe.Maybe" ->
5252 CondExpr () (equal x (NullLit ()))
5353 (obj "Maybe.Nothing")
54− (obj "Maybe.Just" <| go t x)
54+ (obj "Maybe.Just" <| inc t x)
5555
5656 | ctor == "_List" ->
5757 check x JSArray (obj "_J.toList" <| array)
@@ -63,7 +63,7 @@ incoming tipe =
6363 tuple = ObjectLit () $ (PropId () (var "ctor"), string ctor) : values
6464 values = zipWith convert [0..] ts
6565 convert n t = ( PropId () $ var ('_':show n)
66− , go t (BracketRef () x (IntLit () n)))
66+ , inc t (BracketRef () x (IntLit () n)))
6767
6868 Data _ _ -> error "bad ADT got to port generation code"
6969
@@ -73,18 +73,31 @@ incoming tipe =
7373 where
7474 object = ObjectLit () $ (PropId () (var "_"), ObjectLit () []) : keys
7575 keys = map convert fields
76− convert (f,t) = (PropId () (var f), go t (DotRef () x (var f)))
76+ convert (f,t) = (PropId () (var f), inc t (DotRef () x (var f)))
7777
7878outgoing tipe =
7979 case tipe of
8080 Data "Signal.Signal" [t] ->
8181 obj "Native.Ports.outgoingSignal" <| outgoing t
82− _ -> ["v"] ==> go tipe (ref "v")
83− where
84− go :: Type -> Expression () -> Expression ()
85− go tipe x =
86− case tipe of
87− Lambda _ _ -> error "unimplemented"
82+ _ -> ["v"] ==> out tipe (ref "v")
83+
84+out :: Type -> Expression () -> Expression ()
85+out tipe x =
86+ case tipe of
87+ Lambda _ _
88+ | numArgs > 1 && numArgs < 10 ->
89+ func (ref ('A':show numArgs) `call` (x:values))
90+ | otherwise -> func (foldl (<|) x values)
91+ where
92+ ts = T.collectLambdas tipe
93+ numArgs = length ts - 1
94+ args = map (\n -> '_' : show n) [0..]
95+ values = zipWith inc (init ts) (map ref args)
96+ func body = function (take numArgs args)
97+ [ VarDeclStmt () [VarDecl () (var "_r") (Just body)]
98+ , ret (out (last ts) (ref "_r"))
99+ ]
100+
88101 Var _ -> error "type variables should not be allowed through input ports"
89102 Data ctor []
90103 | ctor `elem` ["Int","Float","Bool","String"] -> obj ("_J.from" ++ ctor) <| x
@@ -104,7 +117,7 @@ outgoing tipe =
104117 Data ctor ts | Help.isTuple ctor ->
105118 ArrayLit () $ zipWith convert [0..] ts
106119 where
107− convert n t = go t $ DotRef () x $ var ('_':show n)
120+ convert n t = out t $ DotRef () x $ var ('_':show n)
108121
109122 Data _ _ -> error "bad ADT got to port generation code"
110123
@@ -114,4 +127,4 @@ outgoing tipe =
114127 ObjectLit () keys
115128 where
116129 keys = map convert fields
117− convert (f,t) = (PropId () (var f), go t (DotRef () x (var f)))
130+ convert (f,t) = (PropId () (var f), out t (DotRef () x (var f)))