git.iko.soy/elk
on master help sign in
Get ports working with Maybes and Json
commit5e33985e6b9c1d33cf2be2c44e2bc7f5d4a521cb authorEvan Czaplicki <info@elm-lang.org> dateWed 11 Jun 2014, 16:35 (12 years ago) parent6ed5805
6 files changed+28−24
compare with master
unifiedsplit
compiler/Generate/JavaScript.hs+3−2 compiler/Generate/JavaScript/Ports.hs+7−7 compiler/Generate/JavaScript/Variable.hs+3−7 compiler/Transform/Canonicalize.hs+4−3 compiler/Transform/Canonicalize/Environment.hs+5−1 compiler/Transform/Canonicalize/Variable.hs+6−4
compiler/Generate/JavaScript.hs+3−2
@@ -192,11 +192,12 @@ expression (A region expr) =
192192 return $ ObjectLit () [(PropString () "src", literal (Str src))]
193193
194194 PortIn name tipe ->
195− return $ Var.nativePorts "portIn" `call` [ string name, Port.incoming tipe ]
195+ return $ Var.value "Native.Ports" "portIn" `call`
196+ [ string name, Port.incoming tipe ]
196197
197198 PortOut name tipe value ->
198199 do value' <- expression value
199− return $ Var.nativePorts "portOut" `call`
200+ return $ Var.value "Native.Ports" "portOut" `call`
200201 [ string name, Port.outgoing tipe, value' ]
201202
202203definition :: Canonical.Def -> State Int [Statement ()]
compiler/Generate/JavaScript/Ports.hs+7−7
@@ -2,7 +2,7 @@
22module Generate.JavaScript.Ports (incoming, outgoing) where
33
44import Generate.JavaScript.Helpers
5−import Generate.JavaScript.Variable (nativePorts, nativeJson)
5+import qualified Generate.JavaScript.Variable as V
66import AST.Type as T
77import qualified AST.Variable as Var
88import Language.ECMAScript3.Syntax
@@ -30,7 +30,7 @@ incoming tipe =
3030 Aliased _ t -> incoming t
3131
3232 App (Type v) [t]
33− | Var.isSignal v -> nativePorts "incomingSignal" <| incoming t
33+ | Var.isSignal v -> V.value "Native.Ports" "incomingSignal" <| incoming t
3434
3535 _ -> ["v"] ==> inc tipe (ref "v")
3636
@@ -51,15 +51,15 @@ inc tipe x =
5151 from checks = check x checks x
5252
5353 Type name
54− | Var.isJson name -> nativeJson "fromJS" <| x
54+ | Var.isJson name -> V.value "Native.Json" "fromJS" <| x
5555 | otherwise -> error "bad type got to incoming port generation code"
5656
5757 App f args ->
5858 case f : args of
5959 Type name : [t]
6060 | Var.isMaybe name -> CondExpr () (equal x (NullLit ()))
61− (obj ["Maybe","Nothing"])
62− (obj ["Maybe","Just"] <| inc t x)
61+ (V.value "Maybe" "Nothing")
62+ (V.value "Maybe" "Just" <| inc t x)
6363
6464 | Var.isList name -> check x JSArray (obj ["_L","fromArray"] <| array)
6565
@@ -97,7 +97,7 @@ outgoing tipe =
9797 Aliased _ t -> outgoing t
9898
9999 App (Type v) [t]
100− | Var.isSignal v -> nativePorts "outgoingSignal" <| outgoing t
100+ | Var.isSignal v -> V.value "Native.Ports" "outgoingSignal" <| outgoing t
101101
102102 _ -> ["v"] ==> out tipe (ref "v")
103103
@@ -126,7 +126,7 @@ out tipe x =
126126 | name `elem` ["Int","Float","Bool","String"] -> x
127127
128128 Type name
129− | Var.isJson name -> nativeJson "toJS" <| x
129+ | Var.isJson name -> V.value "Native.Json" "toJS" <| x
130130 | otherwise -> error "bad type got to outgoing port generation code"
131131
132132 App f args ->
compiler/Generate/JavaScript/Variable.hs+3−7
@@ -30,13 +30,9 @@ varName x = map (swap '\'' '$') x'
3030 where
3131 x' = if Set.member x jsReserveds then '$' : x else x
3232
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)
33+value :: String -> String -> JS.Expression ()
34+value home name =
35+ canonical (Var.Canonical (Var.Module home) name)
4036
4137jsReserveds :: Set.Set String
4238jsReserveds = Set.fromList
compiler/Transform/Canonicalize.hs+4−3
@@ -38,8 +38,7 @@ module' interfaces modul =
3838 runState (runErrorT (moduleHelp interfaces modul)) Set.empty
3939
4040 filterImports m =
41− let usedModules' = Set.insert "Native.Ports" usedModules
42− used (name,_) = Set.member name usedModules'
41+ let used (name,_) = Set.member name usedModules
4342 in m { Module.imports = filter used (Module.imports m) }
4443
4544moduleHelp :: Module.Interfaces -> Module.ValidModule
@@ -163,7 +162,9 @@ declaration env decl =
163162 do expanded' <- canonicalize Canonicalize.tipe "type alias" name env expanded
164163 return (D.TypeAlias name tvars expanded')
165164
166− D.Port port ->
165+ D.Port port -> do
166+ Env.uses "Native.Ports"
167+ Env.uses "Native.Json"
167168 D.Port <$> case port of
168169 D.In name t ->
169170 do t' <- canonicalize Canonicalize.tipe "port" name env t
compiler/Transform/Canonicalize/Environment.hs+5−1
@@ -25,11 +25,15 @@ insert key value = Map.insertWith (++) key [value]
2525
2626type Canonicalizer err a = Error.ErrorT err (State.State (Set.Set String)) a
2727
28+uses :: (Error.Error e) => String -> Canonicalizer e ()
29+uses home =
30+ Error.lift (State.modify (Set.insert home))
31+
2832using :: Var.Canonical -> Canonicalizer String Var.Canonical
2933using var@(Var.Canonical home _) =
3034 do case home of
3135 Var.BuiltIn -> return ()
32− Var.Module path -> Error.lift (State.modify (Set.insert path))
36+ Var.Module path -> uses path
3337 Var.Local -> return ()
3438 return var
3539
compiler/Transform/Canonicalize/Variable.hs+6−4
@@ -21,7 +21,7 @@ variable env var =
2121
2222 _ -> case Map.lookup var (_values env) of
2323 Just [v] -> Env.using v
24− Just vs -> Env.using =<< preferLocals "variable" vs var
24+ Just vs -> preferLocals "variable" vs var
2525 Nothing -> notFound "variable" (Map.keys (_values env)) var
2626 where
2727 (modul, name) = case Help.splitDots var of
@@ -33,7 +33,8 @@ tvar :: Environment -> String
3333tvar env var =
3434 case adts ++ aliases of
3535 [] -> notFound "type" (Map.keys (_adts env) ++ Map.keys (_aliases env)) var
36− [v] -> return v
36+ [v] -> do _ <- Env.using (extract v)
37+ return v
3738 vs -> preferLocals' extract "type" vs var
3839 where
3940 adts = map Left . fromMaybe [] $ Map.lookup var (_adts env)
@@ -48,7 +49,7 @@ pvar :: Environment -> String -> Canonicalizer String Var.Canonical
4849pvar env var =
4950 case Map.lookup var (_patterns env) of
5051 Just [v] -> Env.using v
51− Just vs -> Env.using =<< preferLocals "pattern" vs var
52+ Just vs -> preferLocals "pattern" vs var
5253 Nothing -> notFound "pattern" (Map.keys (_patterns env)) var
5354
5455notFound :: String -> [String] -> String -> Canonicalizer String a
@@ -66,7 +67,8 @@ preferLocals' :: (a -> Var.Canonical) -> String -> [a] -> String -> Canonicalize
6667preferLocals' extract kind possibilities var =
6768 case filter (isLocal . extract) possibilities of
6869 [] -> ambiguous possibilities
69− [v] -> return v
70+ [v] -> do _ <- Env.using (extract v)
71+ return v
7072 locals -> ambiguous locals
7173 where
7274 isLocal :: Var.Canonical -> Bool