git.iko.soy/elk
on master help sign in
Update kernel parsing to work properly
ff46029Evan Czaplicki
compiler/src/Elm/Kernel.hs+73−83
compare with master
unifiedsplit
@@ -3,8 +3,8 @@
3module Elm.Kernel
3module Elm.Kernel
4 ( Content(..)
4 ( Content(..)
5 , Chunk(..)
5 , Chunk(..)
6− , Dep(..)
6+ , fromFile
7− , parser
7+ , countFields
8 )
8 )
9 where
9 where
10
10
@@ -15,7 +15,6 @@ import Data.Coerce (coerce)
15import qualified Data.List as List
15import qualified Data.List as List
16import qualified Data.Map as Map
16import qualified Data.Map as Map
17import qualified Data.Name as Name
17import qualified Data.Name as Name
18−import qualified Data.Set as Set
19import qualified Data.Utf8 as Utf8
18import qualified Data.Utf8 as Utf8
20import Data.Word (Word8, Word16)
19import Data.Word (Word8, Word16)
21import Foreign.Ptr (Ptr, plusPtr)
20import Foreign.Ptr (Ptr, plusPtr)
@@ -26,28 +25,14 @@ import qualified Elm.Package as Pkg
26import qualified Parse.Module as Module
25import qualified Parse.Module as Module
27import qualified Parse.Variable as Var
26import qualified Parse.Variable as Var
28import Parse.Utils
27import Parse.Utils
29−import Parse.Primitives hiding (Parser, State)
28+import Parse.Primitives hiding (Parser, fromFile)
30import qualified Parse.Primitives as P
29import qualified Parse.Primitives as P
31import qualified Reporting.Annotation as A
30import qualified Reporting.Annotation as A
32import qualified Reporting.Error.Syntax as E
31import qualified Reporting.Error.Syntax as E
33
32
34
33
35
34
36−-- CONTENT
35+-- CHUNK
37−
38−
39−data Content =
40− Content [Chunk] (Set.Set Dep)
41−
42−
43−data Dep
44− = ElmDep ModuleName.Canonical Name.Name
45− | KernelDep Name.Name
46− deriving (Eq, Ord)
47−
48−
49−
50−-- CHUNKS
51
36
52
37
53data Chunk
38data Chunk
@@ -65,22 +50,55 @@ data UNCHECKED
65
50
66
51
67
52
68−-- PARSE
53+-- COUNT FIELDS
54+
55+
56+countFields :: [Chunk] -> Map.Map Name.Name Int
57+countFields chunks =
58+ foldr addField Map.empty chunks
59+
60+
61+addField :: Chunk -> Map.Map Name.Name Int -> Map.Map Name.Name Int
62+addField chunk fields =
63+ case chunk of
64+ JS _ -> fields
65+ ElmVar _ _ -> fields
66+ JsVar _ _ -> fields
67+ ElmField f -> Map.insertWith (+) f 1 fields
68+ JsField _ -> fields
69+ JsEnum _ -> fields
70+ Debug -> fields
71+ Prod -> fields
72+
73+
74+
75+-- FROM FILE
76+
77+
78+data Content =
79+ Content [Src.Import] [Chunk]
80+
81+
82+type Foreigns =
83+ Map.Map ModuleName.Raw Pkg.Name
69
84
70
85
71−type ImportDict =
86+fromFile :: Pkg.Name -> Foreigns -> FilePath -> IO (Maybe Content)
72− Map.Map Name.Name [Pkg.Name]
87+fromFile pkg foreigns path =
88+ do result <- P.fromFile (parser pkg foreigns) path
89+ case result of
90+ P.Ok content _ -> return (Just content)
91+ P.Err _ _ _ _ -> return Nothing
73
92
74
93
75−parser :: ImportDict -> Parser Content
94+parser :: Pkg.Name -> Foreigns -> Parser Content
76−parser importDict =
95+parser pkg foreigns =
77 do word2 0x2F 0x2A {-/*-} E.XXX
96 do word2 0x2F 0x2A {-/*-} E.XXX
78 Module.freshLine
97 Module.freshLine
79 imports <- Module.chompImports []
98 imports <- Module.chompImports []
80 word2 0x2A 0x2F {-*/-} E.XXX
99 word2 0x2A 0x2F {-*/-} E.XXX
81− let (vtable, deps) = processImports importDict imports
82− chunks <- parseChunks vtable Map.empty Map.empty
100+ chunks <- parseChunks (toVarTable pkg foreigns imports) Map.empty Map.empty
83− return $ Content chunks deps
101+ return (Content imports chunks)
84
102
85
103
86
104
@@ -100,17 +118,11 @@ parseChunks vtable enums fields =
100 cerr row col ctx E.XXX
118 cerr row col ctx E.XXX
101
119
102
120
103−addJS :: Ptr Word8 -> Ptr Word8 -> [Chunk] -> [Chunk]
104−addJS start end revChunks =
105− if start == end
106− then revChunks
107− else JS (Utf8.fromPtr start end) : revChunks
108−
109−
110chompChunks :: VarTable -> Enums -> Fields -> Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> Ptr Word8 -> [Chunk] -> (# [Chunk], Ptr Word8, Word16, Word16 #)
121chompChunks :: VarTable -> Enums -> Fields -> Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> Ptr Word8 -> [Chunk] -> (# [Chunk], Ptr Word8, Word16, Word16 #)
111chompChunks vs es fs pos end row col lastPos revChunks =
122chompChunks vs es fs pos end row col lastPos revChunks =
112 if pos >= end then
123 if pos >= end then
124+ let !js = Utf8.fromPtr lastPos end in
113− (# reverse (addJS lastPos end revChunks), pos, row, col #)
125+ (# reverse (JS js : revChunks), pos, row, col #)
114
126
115 else
127 else
116 let !word = unsafeIndex pos in
128 let !word = unsafeIndex pos in
@@ -120,7 +132,8 @@ chompChunks vs es fs pos end row col lastPos revChunks =
120 !pos3 = plusPtr pos 3
132 !pos3 = plusPtr pos 3
121 in
133 in
122 if pos3 <= end && unsafeIndex pos1 == 0x5F {-_-} then
134 if pos3 <= end && unsafeIndex pos1 == 0x5F {-_-} then
135+ let !js = Utf8.fromPtr lastPos pos in
123− chompTag vs es fs pos3 end row (col + 3) (addJS lastPos pos revChunks)
136+ chompTag vs es fs pos3 end row (col + 3) (JS js : revChunks)
124 else
137 else
125 chompChunks vs es fs pos1 end row (col + 1) lastPos revChunks
138 chompChunks vs es fs pos1 end row (col + 1) lastPos revChunks
126
139
@@ -143,8 +156,11 @@ chompTag vs es fs pos end row col revChunks =
143 !word = unsafeIndex tagPos
156 !word = unsafeIndex tagPos
144 in
157 in
145 if word == 0x24 {-$-} then
158 if word == 0x24 {-$-} then
159+ let
160+ !name = Name.fromPtr pos newPos
161+ in
146 chompChunks vs es fs newPos end row newCol newPos $
162 chompChunks vs es fs newPos end row newCol newPos $
147− ElmField (Name.fromPtr pos newPos) : revChunks
163+ ElmField name : revChunks
148 else
164 else
149 let
165 let
150 !name = Name.fromPtr tagPos newPos
166 !name = Name.fromPtr tagPos newPos
@@ -230,60 +246,34 @@ type VarTable =
230 Map.Map Name.Name Chunk
246 Map.Map Name.Name Chunk
231
247
232
248
233−type State =
249+toVarTable :: Pkg.Name -> Foreigns -> [Src.Import] -> VarTable
234− (VarTable, Set.Set Dep)
250+toVarTable pkg foreigns imports =
235−
251+ List.foldl' (addImport pkg foreigns) Map.empty imports
236
252
237−processImports :: ImportDict -> [Src.Import] -> State
238−processImports importDict imports =
239− List.foldl' (addImport importDict) (Map.empty, Set.empty) imports
240
253
241−
242−addImport :: ImportDict -> State -> Src.Import -> State
254+addImport :: Pkg.Name -> Foreigns -> VarTable -> Src.Import -> VarTable
243−addImport importDict state (Src.Import (A.At _ home) maybeAlias exposing) =
255+addImport pkg foreigns vtable (Src.Import (A.At _ importName) maybeAlias exposing) =
244− if Name.isKernel home then
256+ if Name.isKernel importName then
245 case maybeAlias of
257 case maybeAlias of
246 Just _ ->
258 Just _ ->
247− error ("Cannot use aliases on kernel import of: " ++ Name.toChars home)
259+ error ("cannot use `as` with kernel import of: " ++ Name.toChars importName)
248
260
249 Nothing ->
261 Nothing ->
250− addKernelImport (Name.getKernel home) exposing state
251−
252− else
253− case Map.lookup home importDict of
254− Just [pkg] ->
255 let
262 let
256− canonicalHome = ModuleName.Canonical pkg home
263+ home = Name.getKernel importName
257− prefix = toPrefix home maybeAlias
264+ add table name =
265+ Map.insert (Name.sepBy 0x5F {-_-} home name) (JsVar home name) table
258 in
266 in
259− addNormalImport canonicalHome prefix exposing state
267+ List.foldl' add vtable (toNames exposing)
260−
261− _ ->
262− error ("Cannot find kernel import of: " ++ Name.toChars home)
263−
264
268
265−-- INVARIANT: the `home` is the * in `Elm.Kernel.*`
269+ else
266−--
270+ let
267−addKernelImport :: Name.Name -> Src.Exposing -> State -> State
271+ home = ModuleName.Canonical (Map.findWithDefault pkg importName foreigns) importName
268−addKernelImport home exposing (vtable, deps) =
272+ prefix = toPrefix importName maybeAlias
269− let
273+ add table name =
270− addVar table name =
271− Map.insert (Name.sepBy 0x5F {-_-} home name) (JsVar home name) table
272− in
273− ( List.foldl' addVar vtable (toNames exposing)
274− , Set.insert (KernelDep home) deps
275− )
276−
277−
278−addNormalImport :: ModuleName.Canonical -> Name.Name -> Src.Exposing -> State -> State
279−addNormalImport home prefix exposing state =
280− let
281− addVar (vtable, deps) name =
282− ( Map.insert (Name.sepBy 0x5F {-_-} prefix name) (ElmVar home name) vtable
274+ Map.insert (Name.sepBy 0x5F {-_-} prefix name) (ElmVar home name) table
283− , Set.insert (ElmDep home name) deps
284− )
285− in
275+ in
286− List.foldl' addVar state (toNames exposing)
276+ List.foldl' add vtable (toNames exposing)
287
277
288
278
289toPrefix :: Name.Name -> Maybe Name.Name -> Name.Name
279toPrefix :: Name.Name -> Maybe Name.Name -> Name.Name
@@ -303,7 +293,7 @@ toNames :: Src.Exposing -> [Name.Name]
303toNames exposing =
293toNames exposing =
304 case exposing of
294 case exposing of
305 Src.Open ->
295 Src.Open ->
306− error "Cannot have `exposing (..)` in kernel code."
296+ error "cannot have `exposing (..)` in kernel code."
307
297
308 Src.Explicit exposedList ->
298 Src.Explicit exposedList ->
309 map toName exposedList
299 map toName exposedList