5e33985 · elk · git.iko.soy

compiler/Generate/JavaScript.hs+3−2

compare with master

unifiedsplit

@@ -192,11 +192,12 @@ expression (A region expr) =

192 return $ ObjectLit () [(PropString () "src", literal (Str src))]

193

194 PortIn name tipe ->

195+ return $ Var.value "Native.Ports" "portIn" `call`

195− return $ Var.nativePorts "portIn" `call` [ string name, Port.incoming tipe ]

196+ [ string name, Port.incoming tipe ]

196

197

197 PortOut name tipe value ->

198 PortOut name tipe value ->

198 do value' <- expression value

199 do value' <- expression value

199− return $ Var.nativePorts "portOut" `call`

200+ return $ Var.value "Native.Ports" "portOut" `call`

200 [ string name, Port.outgoing tipe, value' ]

201 [ string name, Port.outgoing tipe, value' ]

201

202

202definition :: Canonical.Def -> State Int [Statement ()]

203definition :: Canonical.Def -> State Int [Statement ()]

compiler/Generate/JavaScript/Ports.hs+7−7

@@ -2,7 +2,7 @@

2module Generate.JavaScript.Ports (incoming, outgoing) where

3

4import Generate.JavaScript.Helpers

5−import Generate.JavaScript.Variable (nativePorts, nativeJson)

5+import qualified Generate.JavaScript.Variable as V

6import AST.Type as T

7import qualified AST.Variable as Var

8import Language.ECMAScript3.Syntax

@@ -30,7 +30,7 @@ incoming tipe =

30 Aliased _ t -> incoming t

31

32 App (Type v) [t]

33− | Var.isSignal v -> nativePorts "incomingSignal" <| incoming t

33+ | Var.isSignal v -> V.value "Native.Ports" "incomingSignal" <| incoming t

34

35 _ -> ["v"] ==> inc tipe (ref "v")

36

@@ -51,15 +51,15 @@ inc tipe x =

51 from checks = check x checks x

52

53 Type name

54− | Var.isJson name -> nativeJson "fromJS" <| x

54+ | Var.isJson name -> V.value "Native.Json" "fromJS" <| x

55 | otherwise -> error "bad type got to incoming port generation code"

56

57 App f args ->

58 case f : args of

59 Type name : [t]

60 | Var.isMaybe name -> CondExpr () (equal x (NullLit ()))

61− (obj ["Maybe","Nothing"])

61+ (V.value "Maybe" "Nothing")

62− (obj ["Maybe","Just"] <| inc t x)

62+ (V.value "Maybe" "Just" <| inc t x)

63

64 | Var.isList name -> check x JSArray (obj ["_L","fromArray"] <| array)

65

@@ -97,7 +97,7 @@ outgoing tipe =

97 Aliased _ t -> outgoing t

98

99 App (Type v) [t]

100− | Var.isSignal v -> nativePorts "outgoingSignal" <| outgoing t

100+ | Var.isSignal v -> V.value "Native.Ports" "outgoingSignal" <| outgoing t

101

102 _ -> ["v"] ==> out tipe (ref "v")

103

@@ -126,7 +126,7 @@ out tipe x =

126 | name `elem` ["Int","Float","Bool","String"] -> x

127

128 Type name

129− | Var.isJson name -> nativeJson "toJS" <| x

129+ | Var.isJson name -> V.value "Native.Json" "toJS" <| x

130 | otherwise -> error "bad type got to outgoing port generation code"

131

132 App f args ->

compiler/Generate/JavaScript/Variable.hs+3−7

@@ -30,13 +30,9 @@ varName x = map (swap '\'' '$') x'

30 where

31 x' = if Set.member x jsReserveds then '$' : x else x

32

33−nativeJson :: String -> JS.Expression ()

34−nativeJson value =

35− canonical (Var.Canonical (Var.Module "Native.Json") value)

36−

37−nativePorts :: String -> JS.Expression ()

33+value :: String -> String -> JS.Expression ()

38−nativePorts value =

34+value home name =

39− canonical (Var.Canonical (Var.Module "Native.Ports") value)

35+ canonical (Var.Canonical (Var.Module home) name)

40

36

41jsReserveds :: Set.Set String

37jsReserveds :: Set.Set String

42jsReserveds = Set.fromList

38jsReserveds = Set.fromList

compiler/Transform/Canonicalize.hs+4−3

@@ -38,8 +38,7 @@ module' interfaces modul =

38 runState (runErrorT (moduleHelp interfaces modul)) Set.empty

39

40 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

43 in m { Module.imports = filter used (Module.imports m) }

42 in m { Module.imports = filter used (Module.imports m) }

44

43

45moduleHelp :: Module.Interfaces -> Module.ValidModule

44moduleHelp :: Module.Interfaces -> Module.ValidModule

@@ -163,7 +162,9 @@ declaration env decl =

163 do expanded' <- canonicalize Canonicalize.tipe "type alias" name env expanded

162 do expanded' <- canonicalize Canonicalize.tipe "type alias" name env expanded

164 return (D.TypeAlias name tvars expanded')

163 return (D.TypeAlias name tvars expanded')

165

164

166− D.Port port ->

165+ D.Port port -> do

166+ Env.uses "Native.Ports"

167+ Env.uses "Native.Json"

167 D.Port <$> case port of

168 D.Port <$> case port of

168 D.In name t ->

169 D.In name t ->

169 do t' <- canonicalize Canonicalize.tipe "port" name env t

170 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]

25

26type Canonicalizer err a = Error.ErrorT err (State.State (Set.Set String)) a

27

28+uses :: (Error.Error e) => String -> Canonicalizer e ()

29+uses home =

30+ Error.lift (State.modify (Set.insert home))

31+

28using :: Var.Canonical -> Canonicalizer String Var.Canonical

32using :: Var.Canonical -> Canonicalizer String Var.Canonical

29using var@(Var.Canonical home _) =

33using var@(Var.Canonical home _) =

30 do case home of

34 do case home of

31 Var.BuiltIn -> return ()

35 Var.BuiltIn -> return ()

32− Var.Module path -> Error.lift (State.modify (Set.insert path))

36+ Var.Module path -> uses path

33 Var.Local -> return ()

37 Var.Local -> return ()

34 return var

38 return var

35

39

compiler/Transform/Canonicalize/Variable.hs+6−4

@@ -21,7 +21,7 @@ variable env var =

21

22 _ -> case Map.lookup var (_values env) of

23 Just [v] -> Env.using v

24− Just vs -> Env.using =<< preferLocals "variable" vs var

24+ Just vs -> preferLocals "variable" vs var

25 Nothing -> notFound "variable" (Map.keys (_values env)) var

26 where

27 (modul, name) = case Help.splitDots var of

@@ -33,7 +33,8 @@ tvar :: Environment -> String

33tvar env var =

34 case adts ++ aliases of

35 [] -> notFound "type" (Map.keys (_adts env) ++ Map.keys (_aliases env)) var

36+ [v] -> do _ <- Env.using (extract v)

36− [v] -> return v

37+ return v

37 vs -> preferLocals' extract "type" vs var

38 vs -> preferLocals' extract "type" vs var

38 where

39 where

39 adts = map Left . fromMaybe [] $ Map.lookup var (_adts env)

40 adts = map Left . fromMaybe [] $ Map.lookup var (_adts env)

@@ -48,7 +49,7 @@ pvar :: Environment -> String -> Canonicalizer String Var.Canonical

48pvar env var =

49pvar env var =

49 case Map.lookup var (_patterns env) of

50 case Map.lookup var (_patterns env) of

50 Just [v] -> Env.using v

51 Just [v] -> Env.using v

51− Just vs -> Env.using =<< preferLocals "pattern" vs var

52+ Just vs -> preferLocals "pattern" vs var

52 Nothing -> notFound "pattern" (Map.keys (_patterns env)) var

53 Nothing -> notFound "pattern" (Map.keys (_patterns env)) var

53

54

54notFound :: String -> [String] -> String -> Canonicalizer String a

55notFound :: String -> [String] -> String -> Canonicalizer String a

@@ -66,7 +67,8 @@ preferLocals' :: (a -> Var.Canonical) -> String -> [a] -> String -> Canonicalize

66preferLocals' extract kind possibilities var =

67preferLocals' extract kind possibilities var =

67 case filter (isLocal . extract) possibilities of

68 case filter (isLocal . extract) possibilities of

68 [] -> ambiguous possibilities

69 [] -> ambiguous possibilities

70+ [v] -> do _ <- Env.using (extract v)

69− [v] -> return v

71+ return v

70 locals -> ambiguous locals

72 locals -> ambiguous locals

71 where

73 where

72 isLocal :: Var.Canonical -> Bool

74 isLocal :: Var.Canonical -> Bool