46bc422 · elk · git.iko.soy

src/AST/Module/Name.hs+13−8

compare with master

unifiedsplit

@@ -5,7 +5,7 @@ module AST.Module.Name

5 , Canonical(..)

6 , inVirtualDom, inCore, inHtml

7 , toString, toText, canonicalToText

8− , isNative, canonicalIsNative

8+ , isKernel, getKernel, canonicalIsKernel

9 )

10 where

11

@@ -71,17 +71,22 @@ canonicalToText (Canonical _ name) =

71

72

73

74−-- IS NATIVE

74+-- IS KERNEL

75

76

77−isNative :: Raw -> Bool

77+isKernel :: Raw -> Bool

78−isNative name =

78+isKernel name =

79− Text.isPrefixOf "Native." name

79+ Text.isPrefixOf "Elm.Kernel." name

80

81

82+getKernel :: Raw -> Text

83+getKernel name =

84+ Text.drop 11 name

85+

86+

82−canonicalIsNative :: Canonical -> Bool

87+canonicalIsKernel :: Canonical -> Bool

83−canonicalIsNative (Canonical _ name) =

88+canonicalIsKernel (Canonical _ name) =

84− isNative name

89+ isKernel name

85

90

86

91

87

92

src/AST/Variable.hs+11−11

@@ -8,7 +8,7 @@ module AST.Variable

8 , inCore, inHtml, cmd, sub

9 , isLocalHome, isCons

10 , is, isJson, isMaybe, isArray, isTask, isList

11− , isNative, isTuple, isPrimitive, isPrim, isLocal

11+ , isKernel, isTuple, isPrimitive, isPrim, isLocal

12 , rawToText, toText

13 )

14 where

@@ -157,23 +157,23 @@ isTask =

157

158

159isList :: Canonical -> Bool

160−isList v =

160+isList var =

161− v == Canonical BuiltIn "List"

161+ var == Canonical BuiltIn "List"

162

163

164−isNative :: Canonical -> Bool

164+isKernel :: Canonical -> Bool

165−isNative v =

165+isKernel var =

166− case v of

166+ case var of

167 Canonical (Module name) _ ->

168− ModuleName.canonicalIsNative name

168+ ModuleName.canonicalIsKernel name

169

170 _ ->

171 False

172

173

174isTuple :: Canonical -> Bool

175−isTuple v =

175+isTuple var =

176− case v of

176+ case var of

177 Canonical BuiltIn name ->

178 Help.isTuple name

179

@@ -182,8 +182,8 @@ isTuple v =

182

183

184isPrimitive :: Canonical -> Bool

185−isPrimitive v =

185+isPrimitive var =

186− case v of

186+ case var of

187 Canonical BuiltIn name ->

188 Set.member name primitiveSet

189

src/Canonicalize/Setup.hs+1−1

@@ -80,7 +80,7 @@ importToPatches importDict allInterfaces (A.A region (rawImportName, method)) =

80 in

81 case maybeInterface of

82 Nothing ->

83− if ModuleName.isNative rawImportName then

83+ if ModuleName.isKernel rawImportName then

84 Result.ok []

85

86 else

src/Canonicalize/Variable.hs+1−1

@@ -52,7 +52,7 @@ logVar var =

52variable :: R.Region -> Env.Env -> Text -> Result Var.Canonical

53variable region env var =

54 case toVarName var of

55− Right (name, varName) | ModuleName.isNative name ->

55+ Right (name, varName) | ModuleName.isKernel name ->

56 let

57 localPkg =

58 ModuleName._package (Env._home env)

src/Elm/Compiler/Objects.hs+3−1

@@ -1,6 +1,8 @@

1{-# OPTIONS_GHC -Wall #-}

2module Elm.Compiler.Objects

3+ ( SymbolTable

4+ , symbolTable

3− ( Symbol(..)

5+ , Symbol(..)

4 , Graph

6 , Graph

5 , union

7 , union

6 , unions

8 , unions

src/Elm/Compiler/Objects/Internal.hs+10−4

@@ -6,6 +6,7 @@ module Elm.Compiler.Objects.Internal

6 , union

7 , unions

8 , SymbolTable

9+ , symbolTable

9 , Symbol(..)

10 , Symbol(..)

10 , lookup

11 , lookup

11 , Roots

12 , Roots

@@ -65,6 +66,15 @@ destruct (Graph graph) =

65-- SYMBOLS

66-- SYMBOLS

66

67

68

69+newtype SymbolTable =

70+ SymbolTable (Map.Map Var.Global Symbol)

71+

72+

73+symbolTable :: Map.Map Var.Global Symbol -> SymbolTable

74+symbolTable =

75+ SymbolTable

76+

77+

68data Symbol =

78data Symbol =

69 Symbol

79 Symbol

70 { _home :: !Word16

80 { _home :: !Word16

@@ -72,10 +82,6 @@ data Symbol =

72 }

82 }

73

83

74

84

75−newtype SymbolTable =

76− SymbolTable (Map.Map Var.Global Symbol)

77−

78−

79lookup :: Var.Global -> SymbolTable -> Maybe Symbol

85lookup :: Var.Global -> SymbolTable -> Maybe Symbol

80lookup var (SymbolTable symbols) =

86lookup var (SymbolTable symbols) =

81 Map.lookup var symbols

87 Map.lookup var symbols

src/Generate/JavaScript.hs+8−8

@@ -29,7 +29,7 @@ import qualified Generate.JavaScript.Variable as JS

29generate :: Obj.SymbolTable -> Obj.Graph -> Obj.Roots -> (Set.Set ModuleName.Canonical, BS.Builder)

30generate symbols (Obj.Graph graph) roots =

31 let

32− (State builders _ natives effects table) =

32+ (State builders _ kernels effects table) =

33 List.foldl' (crawl graph) (init symbols) (Obj.toGlobals roots)

34

35 managers =

@@ -38,7 +38,7 @@ generate symbols (Obj.Graph graph) roots =

38 javascript =

39 List.foldl' (\rest stmt -> JS.encodeUtf8 stmt <> rest) managers builders

40 in

41− (natives, javascript)

41+ (kernels, javascript)

42

43

44

@@ -49,7 +49,7 @@ data State =

49 State

50 { _stmts :: [JS.Stmt]

51 , _seen :: Set.Set Var.Global

52− , _natives :: Set.Set ModuleName.Canonical

52+ , _kernels :: Set.Set ModuleName.Canonical

53 , _effects :: Map.Map ModuleName.Canonical Effects.ManagerType

54 , _table :: JS.Table

55 }

@@ -68,7 +68,7 @@ type Graph = Map.Map Var.Global Opt.Decl

68

69

70crawl :: Graph -> State -> Var.Global -> State

71−crawl graph state@(State js seen natives effects table) name@(Var.Global home _) =

71+crawl graph state@(State js seen kernels effects table) name@(Var.Global home _) =

72 if Set.member name seen then

73 state

74

@@ -81,8 +81,8 @@ crawl graph state@(State js seen natives effects table) name@(Var.Global home _)

81 crawlDecl graph name decl state

82

83 Nothing ->

84− if ModuleName.canonicalIsNative home then

84+ if ModuleName.canonicalIsKernel home then

85− State js seen (Set.insert home natives) effects table

85+ State js seen (Set.insert home kernels) effects table

86 else

87 error (crawlError name)

88

@@ -93,7 +93,7 @@ crawlDecl graph var@(Var.Global home name) (Opt.Decl deps fx body) state =

93 newState =

94 state { _seen = Set.insert var (_seen state) }

95

96− (State stmts seen natives effects table) =

96+ (State stmts seen kernels effects table) =

97 Set.foldl' (crawl graph) newState deps

98

99 (stmt, newTable) =

@@ -102,7 +102,7 @@ crawlDecl graph var@(Var.Global home name) (Opt.Decl deps fx body) state =

102 State

103 { _stmts = stmt : stmts

104 , _seen = seen

105− , _natives = natives

105+ , _kernels = kernels

106 , _effects = maybe id (Map.insert home) fx effects

107 , _table = newTable

108 }

src/Generate/JavaScript/BuiltIn.hs+8−8

@@ -39,7 +39,7 @@ char c =

39

40utils :: Text -> [JS.Expr] -> Generator JS.Expr

41utils name args =

42− do func <- core "Native.Utils" name

42+ do func <- core "Elm.Kernel.Utils" name

43 return $ JS.Call func args

44

45

@@ -54,13 +54,13 @@ core home name =

54

55list :: [JS.Expr] -> Generator JS.Expr

56list elements =

57− do fromArray <- core "Native.List" "fromArray"

57+ do fromArray <- core "Elm.Kernel.List" "fromArray"

58 return $ fromArray <| JS.Array elements

59

60

61cons :: JS.Expr -> JS.Expr -> Generator JS.Expr

62cons first rest =

63− do func <- core "Native.List" "Cons"

63+ do func <- core "Elm.Kernel.List" "Cons"

64 return $ JS.Call func [first, rest]

65

66

@@ -96,24 +96,24 @@ cmp left right =

96

97effectManagers :: Generator JS.Expr

98effectManagers =

99− core "Native.Platform" "effectManagers"

99+ core "Elm.Kernel.Platform" "effectManagers"

100

101

102effect :: ModuleName.Canonical -> Generator JS.Expr

103effect effectName =

104− do leaf <- core "Native.Platform" "leaf"

104+ do leaf <- core "Elm.Kernel.Platform" "leaf"

105 return $ leaf <| JS.String (ModuleName.canonicalToText effectName)

106

107

108outgoingPort :: Text -> JS.Expr -> Generator JS.Expr

109outgoingPort name converter =

110− do outPort <- core "Native.Platform" "outgoingPort"

110+ do outPort <- core "Elm.Kernel.Platform" "outgoingPort"

111 return $ JS.Call outPort [ JS.String name, converter ]

112

113

114incomingPort :: Text -> JS.Expr -> Generator JS.Expr

115incomingPort name converter =

116− do inPort <- core "Native.Platform" "incomingPort"

116+ do inPort <- core "Elm.Kernel.Platform" "incomingPort"

117 return $ JS.Call inPort [ JS.String name, converter ]

118

119

@@ -123,7 +123,7 @@ incomingPort name converter =

123

124staticProgram :: Generator JS.Expr

125staticProgram =

126− Var.global (Var.Global (ModuleName.inVirtualDom "Native.VirtualDom") "staticProgram")

126+ Var.global (Var.Global (ModuleName.inVirtualDom "Elm.Kernel.VirtualDom") "staticProgram")

127

128

129

src/Generate/JavaScript/Expression.hs+2−1

@@ -200,7 +200,8 @@ generateCode expr =

200 JsExpr <$> BuiltIn.effect moduleName

201

202 OutgoingPort name tipe ->

203+ do encoder <- Foreign.encode tipe

203− JsExpr <$> BuiltIn.outgoingPort name (Foreign.encode tipe)

204+ JsExpr <$> BuiltIn.outgoingPort name encoder

204

205

205 IncomingPort name tipe ->

206 IncomingPort name tipe ->

206 do jsDecoder <- generateJsExpr (Foreign.decode tipe)

207 do jsDecoder <- generateJsExpr (Foreign.decode tipe)

src/Generate/JavaScript/Foreign.hs+30−30

@@ -3,6 +3,7 @@

3module Generate.JavaScript.Foreign (encode, decode) where

4

5import Prelude hiding (maybe)

6+import Control.Monad (zipWithM)

6import qualified Data.List as List

7import qualified Data.List as List

7import qualified Data.Text as Text

8import qualified Data.Text as Text

8import Data.Text (Text)

9import Data.Text (Text)

@@ -15,18 +16,20 @@ import qualified AST.Variable as Var

15import qualified Generate.JavaScript.Builder as JS

16import qualified Generate.JavaScript.Builder as JS

16import qualified Generate.JavaScript.Helpers as JS (function, ref)

17import qualified Generate.JavaScript.Helpers as JS (function, ref)

17import Generate.JavaScript.Helpers ((<|), (==>))

18import Generate.JavaScript.Helpers ((<|), (==>))

19+import qualified Generate.JavaScript.Variable as JS (Generator, global)

18

20

19

21

20

22

21-- ENCODE

23-- ENCODE

22

24

23

25

24−encode :: T.Canonical -> JS.Expr

26+encode :: T.Canonical -> JS.Generator JS.Expr

25encode tipe =

27encode tipe =

26− JS.function ["v"] [ JS.Return (Just (encodeHelp tipe (JS.ref "v"))) ]

28+ do js <- encodeHelp tipe (JS.ref "v")

29+ return $ JS.function ["v"] [ JS.Return (Just js) ]

27

30

28

31

29−encodeHelp :: T.Canonical -> JS.Expr -> JS.Expr

32+encodeHelp :: T.Canonical -> JS.Expr -> JS.Generator JS.Expr

30encodeHelp tipe expr =

33encodeHelp tipe expr =

31 case tipe of

34 case tipe of

32 T.Aliased _ args t ->

35 T.Aliased _ args t ->

@@ -39,12 +42,12 @@ encodeHelp tipe expr =

39 error "encodeHelp: type variable"

42 error "encodeHelp: type variable"

40

43

41 T.Type name

44 T.Type name

42− | Var.isPrim "Float" name -> expr

45+ | Var.isPrim "Float" name -> pure expr

43− | Var.isPrim "Int" name -> expr

46+ | Var.isPrim "Int" name -> pure expr

44− | Var.isPrim "Bool" name -> expr

47+ | Var.isPrim "Bool" name -> pure expr

45− | Var.isPrim "String" name -> expr

48+ | Var.isPrim "String" name -> pure expr

46− | Var.isJson name -> expr

49+ | Var.isJson name -> pure expr

47− | Var.isTuple name -> JS.Null

50+ | Var.isTuple name -> pure JS.Null

48 | otherwise -> error "encodeHelp: bad type"

51 | otherwise -> error "encodeHelp: bad type"

49

52

50 T.App (T.Type name) [arg]

53 T.App (T.Type name) [arg]

@@ -65,44 +68,41 @@ encodeHelp tipe expr =

65 T.Record fields Nothing ->

68 T.Record fields Nothing ->

66 let

69 let

67 convert (k, t) =

70 convert (k, t) =

68− k ==> encodeHelp t (JS.DotRef expr (JS.Id k))

71+ (==>) k <$> encodeHelp t (JS.DotRef expr (JS.Id k))

69 in

72 in

70− JS.Object (map convert fields)

73+ JS.Object <$> traverse convert fields

71

74

72

75

73−fromMaybe :: T.Canonical -> JS.Expr -> JS.Expr

76+fromMaybe :: T.Canonical -> JS.Expr -> JS.Generator JS.Expr

74fromMaybe tipe expr =

77fromMaybe tipe expr =

75− JS.If

78+ do js <- encodeHelp tipe (JS.DotRef expr (JS.Id "_0"))

76− (JS.Infix JS.OpStrictEq (JS.DotRef expr (JS.Id "ctor")) (JS.String "Nothing"))

79+ let isNothing = JS.Infix JS.OpStrictEq (JS.DotRef expr (JS.Id "ctor")) (JS.String "Nothing")

77− (JS.Null)

80+ return $ JS.If isNothing JS.Null js

78− (encodeHelp tipe (JS.DotRef expr (JS.Id "_0")))

79

81

80

82

81−fromList :: T.Canonical -> JS.Expr -> JS.Expr

83+fromList :: T.Canonical -> JS.Expr -> JS.Generator JS.Expr

82fromList tipe expr =

84fromList tipe expr =

83− let

85+ do let var = Var.Global (ModuleName.inCore "Elm.Kernel.List") "toArray"

84− array =

86+ toArray <- JS.global var

85− error "TODO port fromList" expr -- Var.coreNative "List" "toArray" <| expr

87+ encoder <- encode tipe

86− in

87− JS.DotRef array (JS.Id "map") <| encode tipe

88+ return $ JS.DotRef (toArray <| expr) (JS.Id "map") <| encoder

88

89

90

90−fromArray :: T.Canonical -> JS.Expr -> JS.Expr

91+fromArray :: T.Canonical -> JS.Expr -> JS.Generator JS.Expr

91fromArray tipe expr =

92fromArray tipe expr =

92− let

93+ do let var = Var.Global (ModuleName.inCore "Elm.Kernel.Array") "toJSArray"

93− array =

94+ toArray <- JS.global var

94− error "TODO port fromArray" expr -- Var.coreNative "Array" "toJSArray" <| expr

95+ encoder <- encode tipe

95− in

96− JS.DotRef array (JS.Id "map") <| encode tipe

96+ return $ JS.DotRef (toArray <| expr) (JS.Id "map") <| encoder

97

98

99−fromTuple :: [T.Canonical] -> JS.Expr -> JS.Expr

99+fromTuple :: [T.Canonical] -> JS.Expr -> JS.Generator JS.Expr

100fromTuple types expr =

101 let

102 convert subType n =

103 encodeHelp subType $ JS.DotRef expr (JS.Id (Text.pack ('_':show n)))

104 in

105− JS.Array (zipWith convert types [ 0 .. length types ])

105+ JS.Array <$> zipWithM convert types [ 0 .. length types ]

106

107

108

src/Generate/JavaScript/Variable.hs+19−14

@@ -1,5 +1,6 @@

1{-# OPTIONS_GHC -Wall #-}

2{-# LANGUAGE OverloadedStrings #-}

3+{-# LANGUAGE UnboxedTuples #-}

3module Generate.JavaScript.Variable

4module Generate.JavaScript.Variable

4 ( Generator

5 ( Generator

5 , run

6 , run

@@ -142,24 +143,28 @@ getGlobalNameHelp var@(Var.Global home name) (Table uid names symbols) =

142 return jsName

143 return jsName

143

144

144 Nothing ->

145 Nothing ->

146+ let

147+ (# newUid, newName #) =

145− case Help.isOp name of

148+ if Help.isOp name

146− False ->

147− do let jsName = globalToName home name

148− State.put (Table uid (Map.insert var jsName names) symbols)

149− return jsName

150−

151− True ->

152− do let jsName = globalToName home ("_op" <> Text.pack (show uid))

149+ then (# uid + 1, "_op" <> Text.pack (show uid) #)

150+ else (# uid, name #)

151+ in

152+ do let jsName = globalToName home newName

153− State.put (Table (uid + 1) (Map.insert var jsName names) symbols)

153+ let newNames = Map.insert var jsName names

154+ State.put (Table newUid newNames symbols)

154− return jsName

155+ return jsName

155

156

157

157globalToName :: ModuleName.Canonical -> Text -> Text

158globalToName :: ModuleName.Canonical -> Text -> Text

158globalToName (ModuleName.Canonical (Pkg.Name user project) moduleName) name =

159globalToName (ModuleName.Canonical (Pkg.Name user project) moduleName) name =

160+ if ModuleName.isKernel moduleName then

161+ "_" <> ModuleName.getKernel moduleName <> "_" <> name

162+

163+ else

159− Text.replace "-" "_" user

164+ Text.replace "-" "_" user

160− <> "$" <> Text.replace "-" "_" project

165+ <> "$" <> Text.replace "-" "_" project

161− <> "$" <> Text.replace "." "_" moduleName

166+ <> "$" <> Text.replace "." "_" moduleName

162− <> "$" <> name

167+ <> "$" <> name

163

168

164

169

165

170

src/Type/Solve.hs+1−1

@@ -200,7 +200,7 @@ actuallySolve constraint =

200 TS.makeInstance tipe

201

202 Nothing ->

203− if Text.isPrefixOf "Native." name then

203+ if Text.isPrefixOf "Elm.Kernel." name then

204 liftIO (mkVar Nothing)

205

206 else