git.iko.soy/elk
on master help sign in
Combine Parse.Kernel into Elm.Kernel
93f583aEvan Czaplicki
src/Elm/Kernel.hs+180−14
compare with master
unifiedsplit
@@ -1,31 +1,197 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2+{-# LANGUAGE OverloadedStrings #-}
2module Elm.Kernel
3module Elm.Kernel
3− ( Kernel.Data(..)
4+ ( Kernel(..)
4− , Kernel.Content
5 , parse
5 , parse
6 )
6 )
7 where
7 where
8
8
9
9
10−import Data.Text (Text)
10+import qualified Data.ByteString as B
11+import qualified Data.Map as Map
12+import Data.Monoid ((<>))
13+import qualified Data.Text as Text
14+import Data.Word (Word8)
11
15
16+
12−import qualified AST.Kernel as Kernel (Data(..), Content(..))
17+import qualified AST.Optimized as Opt
18+import qualified AST.Source as Src
19+import qualified AST.Module.Name as ModuleName
13−import qualified Elm.Compiler.Internals as I
20+import qualified Elm.Name as N
14−import qualified Parse.Helpers as Parse (run)
21+import Parse.Primitives (Parser, run)
15−import qualified Parse.Kernel as Kernel (parser)
22+import qualified Parse.Primitives.Kernel as K
23+import qualified Parse.Primitives.Symbol as Symbol
24+import qualified Parse.Module as Module
16import qualified Reporting.Annotation as A
25import qualified Reporting.Annotation as A
17−import qualified Reporting.Error as Error
26+import qualified Reporting.Error as E
27+
28+
18
29
30+-- PARSE
19
31
20
32
21−-- PARSE KERNEL
33+data Kernel =
34+ Kernel
35+ { _imports :: [(N.Name, N.Name)]
36+ , _chunks :: [Opt.KChunk]
37+ }
22
38
23
39
24−parse :: Text -> Either I.Error Kernel.Content
40+parse :: B.ByteString -> Either E.Error Kernel
25parse sourceCode =
41parse sourceCode =
26− case Parse.run Kernel.parser sourceCode of
42+ case run parser sourceCode of
27− Right content ->
43+ Right kernel ->
28− Right content
44+ Right kernel
29
45
30 Left err ->
46 Left err ->
31− Left (I.Error (A.map Error.Syntax err))
47+ Left (E.Syntax err)
48+
49+
50+
51+-- PARSER
52+
53+
54+parser :: Parser Kernel
55+parser =
56+ do Symbol.jsMultiCommentOpen
57+ Module.freshLine
58+ srcImports <- Module.chompImports []
59+ Symbol.jsMultiCommentClose
60+ let imports = Map.unions (map destructImport srcImports)
61+ chunks <- parserHelp imports Map.empty Map.empty []
62+ return $ Kernel (Map.elems imports) chunks
63+
64+
65+parserHelp :: Imports -> Enums -> Fields -> [Opt.KChunk] -> Parser [Opt.KChunk]
66+parserHelp imports enums fields chunks =
67+ do (javascript, maybeTag) <- K.chunk
68+ case maybeTag of
69+ Nothing ->
70+ return (Opt.JS javascript : chunks)
71+
72+ Just tag ->
73+ case tag of
74+ K.Prod ->
75+ parserHelp imports enums fields $
76+ Opt.Prod : Opt.JS javascript : chunks
77+
78+ K.Debug ->
79+ parserHelp imports enums fields $
80+ Opt.Debug : Opt.JS javascript : chunks
81+
82+ K.Import var ->
83+ case Map.lookup var imports of
84+ Nothing ->
85+ error ("Bad kernel symbol: " ++ Text.unpack var)
86+
87+ Just (home, name) ->
88+ parserHelp imports enums fields $
89+ Opt.Var home name : Opt.JS javascript : chunks
90+
91+ K.Enum n var ->
92+ let (enum, newEnums) = lookupEnum n var enums in
93+ parserHelp imports newEnums fields $
94+ Opt.Enum enum : Opt.JS javascript : chunks
95+
96+ K.ElmField name ->
97+ parserHelp imports enums fields $
98+ Opt.ElmField name : Opt.JS javascript : chunks
99+
100+ K.JsField name ->
101+ let (field, newFields) = lookupField name fields in
102+ parserHelp imports enums newFields $
103+ Opt.JsField field : Opt.JS javascript : chunks
104+
105+
106+
107+-- FIELDS
108+
109+
110+type Fields =
111+ Map.Map Text.Text Int
112+
113+
114+lookupField :: Text.Text -> Fields -> (Int, Fields)
115+lookupField name fields =
116+ case Map.lookup name fields of
117+ Just n ->
118+ ( n, fields )
119+
120+ Nothing ->
121+ let n = Map.size fields in
122+ ( n, Map.insert name n fields )
123+
124+
125+
126+-- ENUMS
127+
128+
129+type Enums =
130+ Map.Map Word8 (Map.Map N.Name Int)
131+
132+
133+lookupEnum :: Word8 -> N.Name -> Enums -> (Int, Enums)
134+lookupEnum word var allEnums =
135+ let
136+ enums =
137+ Map.findWithDefault Map.empty word allEnums
138+ in
139+ case Map.lookup var enums of
140+ Just n ->
141+ ( n, allEnums )
142+
143+ Nothing ->
144+ let n = Map.size enums in
145+ ( n, Map.insert word (Map.insert var n enums) allEnums )
146+
147+
148+
149+-- IMPORTS
150+
151+
152+type Imports =
153+ Map.Map Text.Text (N.Name, N.Name)
154+
155+
156+destructImport :: Src.Import -> Imports
157+destructImport (Src.Import (A.At _ moduleName) maybeAlias exposing) =
158+ let
159+ shortName =
160+ case maybeAlias of
161+ Just alias ->
162+ alias
163+
164+ Nothing ->
165+ if ModuleName.isKernel moduleName then
166+ ModuleName.getKernel moduleName
167+ else if Text.isInfixOf "." moduleName then
168+ error ("modules with dots in kernel code need an alias: " ++ show moduleName)
169+ else
170+ moduleName
171+
172+ toEntry name =
173+ ( shortName <> "_" <> name, ( moduleName, name ) )
174+ in
175+ Map.fromList $ map toEntry $
176+ case exposing of
177+ Src.Open ->
178+ error "cannot have open imports in kernel code"
179+
180+ Src.Explicit exposed ->
181+ map exposedToName exposed
182+
183+
184+exposedToName :: A.Located Src.Exposed -> N.Name
185+exposedToName (A.At _ exposed) =
186+ case exposed of
187+ Src.Lower name ->
188+ name
189+
190+ Src.Upper name Src.Private ->
191+ name
192+
193+ Src.Upper _ Src.Public ->
194+ error "cannot have Maybe(..) syntax in kernel code header"
195+
196+ Src.Operator _ ->
197+ error "cannot use binops in kernel code"
src/Parse/Kernel.hsdeleted−173
@@ -1,173 +0,0 @@
1−{-# OPTIONS_GHC -Wall #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−module Parse.Kernel
4− ( parser
5− )
6− where
7−
8−
9−import qualified Data.Map as Map
10−import Data.Monoid ((<>))
11−import Data.Text (Text)
12−import qualified Data.Text as Text
13−import Data.Word (Word8)
14−
15−import qualified AST.Optimized as Opt
16−import qualified AST.Source as Src
17−import qualified AST.Module.Name as ModuleName
18−import qualified Elm.Name as N
19−import Parse.Primitives (Parser)
20−import qualified Parse.Primitives.Kernel as K
21−import qualified Parse.Primitives.Symbol as Symbol
22−import qualified Parse.Module as Module
23−import qualified Reporting.Annotation as A
24−
25−
26−
27−-- PARSER
28−
29−
30−parser :: Parser ( [(N.Name, N.Name)], [Opt.KChunk] )
31−parser =
32− do Symbol.jsMultiCommentOpen
33− Module.freshLine
34− srcImports <- Module.chompImports []
35− Symbol.jsMultiCommentClose
36− let imports = Map.unions (map destructImport srcImports)
37− chunks <- parserHelp imports Map.empty Map.empty []
38− return ( Map.elems imports, chunks )
39−
40−
41−parserHelp :: Imports -> Enums -> Fields -> [Opt.KChunk] -> Parser [Opt.KChunk]
42−parserHelp imports enums fields chunks =
43− do (javascript, maybeTag) <- K.chunk
44− case maybeTag of
45− Nothing ->
46− return (Opt.JS javascript : chunks)
47−
48− Just tag ->
49− case tag of
50− K.Prod ->
51− parserHelp imports enums fields $
52− Opt.Prod : Opt.JS javascript : chunks
53−
54− K.Debug ->
55− parserHelp imports enums fields $
56− Opt.Debug : Opt.JS javascript : chunks
57−
58− K.Import var ->
59− case Map.lookup var imports of
60− Nothing ->
61− error ("Bad kernel symbol: " ++ Text.unpack var)
62−
63− Just (home, name) ->
64− parserHelp imports enums fields $
65− Opt.Var home name : Opt.JS javascript : chunks
66−
67− K.Enum n var ->
68− let (enum, newEnums) = lookupEnum n var enums in
69− parserHelp imports newEnums fields $
70− Opt.Enum enum : Opt.JS javascript : chunks
71−
72− K.ElmField name ->
73− parserHelp imports enums fields $
74− Opt.ElmField name : Opt.JS javascript : chunks
75−
76− K.JsField name ->
77− let (field, newFields) = lookupField name fields in
78− parserHelp imports enums newFields $
79− Opt.JsField field : Opt.JS javascript : chunks
80−
81−
82−
83−-- FIELDS
84−
85−
86−type Fields =
87− Map.Map Text Int
88−
89−
90−lookupField :: Text -> Fields -> (Int, Fields)
91−lookupField name fields =
92− case Map.lookup name fields of
93− Just n ->
94− ( n, fields )
95−
96− Nothing ->
97− let n = Map.size fields in
98− ( n, Map.insert name n fields )
99−
100−
101−
102−-- ENUMS
103−
104−
105−type Enums =
106− Map.Map Word8 (Map.Map N.Name Int)
107−
108−
109−lookupEnum :: Word8 -> N.Name -> Enums -> (Int, Enums)
110−lookupEnum word var allEnums =
111− let
112− enums =
113− Map.findWithDefault Map.empty word allEnums
114− in
115− case Map.lookup var enums of
116− Just n ->
117− ( n, allEnums )
118−
119− Nothing ->
120− let n = Map.size enums in
121− ( n, Map.insert word (Map.insert var n enums) allEnums )
122−
123−
124−
125−-- IMPORTS
126−
127−
128−type Imports =
129− Map.Map Text (N.Name, N.Name)
130−
131−
132−destructImport :: Src.Import -> Imports
133−destructImport (Src.Import (A.At _ moduleName) maybeAlias exposing) =
134− let
135− shortName =
136− case maybeAlias of
137− Just alias ->
138− alias
139−
140− Nothing ->
141− if ModuleName.isKernel moduleName then
142− ModuleName.getKernel moduleName
143− else if Text.isInfixOf "." moduleName then
144− error ("modules with dots in kernel code need an alias: " ++ show moduleName)
145− else
146− moduleName
147−
148− toEntry name =
149− ( shortName <> "_" <> name, ( moduleName, name ) )
150− in
151− Map.fromList $ map toEntry $
152− case exposing of
153− Src.Open ->
154− error "cannot have open imports in kernel code"
155−
156− Src.Explicit exposed ->
157− map exposedToName exposed
158−
159−
160−exposedToName :: A.Located Src.Exposed -> N.Name
161−exposedToName (A.At _ exposed) =
162− case exposed of
163− Src.Lower name ->
164− name
165−
166− Src.Upper name Src.Private ->
167− name
168−
169− Src.Upper _ Src.Public ->
170− error "cannot have Maybe(..) syntax in kernel code header"
171−
172− Src.Operator _ ->
173− error "cannot use binops in kernel code"