git.iko.soy/elk
on master help sign in
Support unit values flowing through ports
c8eeedfEvan Czaplicki
compiler/Generate/JavaScript/Ports.hs+16−10
compare with master
unifiedsplit
@@ -52,6 +52,7 @@ inc tipe x =
52
52
53 Type name
53 Type name
54 | Var.isJson name -> V.value "Native.Json" "fromJS" <| x
54 | Var.isJson name -> V.value "Native.Json" "fromJS" <| x
55+ | Var.isTuple name -> incomingTuple [] x
55 | otherwise -> error "bad type got to incoming port generation code"
56 | otherwise -> error "bad type got to incoming port generation code"
56
57
57 App f args ->
58 App f args ->
@@ -68,16 +69,7 @@ inc tipe x =
68 array = DotRef () x (var "map") <| incoming t
69 array = DotRef () x (var "map") <| incoming t
69
70
70 Type name : ts
71 Type name : ts
71− | Var.isTuple name -> check x JSArray tuple
72+ | Var.isTuple name -> incomingTuple ts x
72− where
73− tuple = ObjectLit () $ (prop "ctor", ctor) : values
74−
75− ctor = string ("_Tuple" ++ show (length ts))
76− values = zipWith convert [0..] ts
77−
78− convert n t = ( prop ('_':show n)
79− , inc t (BracketRef () x (IntLit () n))
80− )
81
73
82 _ -> error "bad ADT got to incoming port generation code"
74 _ -> error "bad ADT got to incoming port generation code"
83
75
@@ -91,6 +83,19 @@ inc tipe x =
91 keys = map convert fields
83 keys = map convert fields
92 convert (f,t) = (prop f, inc t (DotRef () x (var f)))
84 convert (f,t) = (prop f, inc t (DotRef () x (var f)))
93
85
86+incomingTuple :: [CanonicalType] -> Expression () -> Expression ()
87+incomingTuple types x =
88+ check x JSArray (ObjectLit () fields)
89+ where
90+ fields = (prop "ctor", ctor) : zipWith convert [0..] types
91+
92+ ctor = string ("_Tuple" ++ show (length types))
93+
94+ convert n t =
95+ ( prop ('_':show n)
96+ , inc t (BracketRef () x (IntLit () n))
97+ )
98+
94outgoing :: CanonicalType -> Expression ()
99outgoing :: CanonicalType -> Expression ()
95outgoing tipe =
100outgoing tipe =
96 case tipe of
101 case tipe of
@@ -127,6 +132,7 @@ out tipe x =
127
132
128 Type name
133 Type name
129 | Var.isJson name -> V.value "Native.Json" "toJS" <| x
134 | Var.isJson name -> V.value "Native.Json" "toJS" <| x
135+ | Var.isTuple name -> ArrayLit () []
130 | otherwise -> error "bad type got to outgoing port generation code"
136 | otherwise -> error "bad type got to outgoing port generation code"
131
137
132 App f args ->
138 App f args ->
compiler/Type/ExtraChecks.hs+1
@@ -65,6 +65,7 @@ portTypes expr =
65 ST.Type v
65 ST.Type v
66 | V.isJson v -> return ()
66 | V.isJson v -> return ()
67 | V.isPrimitive v -> return ()
67 | V.isPrimitive v -> return ()
68+ | V.isTuple v -> return ()
68 | otherwise -> err "an unsupported type"
69 | otherwise -> err "an unsupported type"
69
70
70 ST.App t [] -> valid t
71 ST.App t [] -> valid t