git.iko.soy/elk
on e00a3f3 help sign in
elk/src/Parse/Kernel.hs
134 lines 3.5 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Parse.Kernel
4 ( parser
5 )
6 where
9import qualified Data.ByteString as BS
10import qualified Data.ByteString.Builder as BS
11import qualified Data.ByteString.Lazy as LBS
12import qualified Data.Map as Map
13import Data.Monoid ((<>))
14import Data.Text (Text)
15import qualified Data.Text as Text
16import Data.Word (Word8)
18import qualified AST.Exposing as Exposing
19import qualified AST.Kernel as Kernel
20import qualified AST.Module as Module
21import qualified AST.Module.Name as Module
22import Parse.Helpers (Parser)
23import qualified Parse.Helpers as Parse
24import qualified Parse.Module as Parse
25import qualified Reporting.Annotation as A
29-- PARSER
32parser :: Parser Kernel.Info
33parser =
34 do imports <- Parse.kernelHeader
35 let table = Map.unions (map importToTable imports)
36 chunks <- parserHelp table Map.empty []
37 return (Kernel.Info (Map.elems table) chunks)
40type Enums =
41 Map.Map Word8 (Map.Map Text BS.ByteString)
44parserHelp :: Table -> Enums -> [Kernel.Chunk] -> Parser [Kernel.Chunk]
45parserHelp table enums chunks =
46 do (javascript, maybeMore) <- Parse.kernelChunk
47 case maybeMore of
48 Nothing ->
49 return (Kernel.JS javascript : chunks)
51 Just (Parse.KernelImport, var) ->
52 case Map.lookup var table of
53 Nothing ->
54 error $ show $ "could not find " <> var <> " when parsing kernel code"
56 Just (home, name) ->
57 parserHelp table enums (Kernel.Var home name : Kernel.JS javascript : chunks)
59 Just (Parse.KernelEnum n, var) ->
60 let
61 (bytes, newEnums) =
62 lookupEnum n var enums
63 in
64 parserHelp table newEnums (Kernel.JS bytes : Kernel.JS javascript : chunks)
67lookupEnum :: Word8 -> Text -> Enums -> (BS.ByteString, Enums)
68lookupEnum word var allEnums =
69 case Map.lookup word allEnums of
70 Nothing ->
71 ( "0", Map.insert word (Map.singleton var "0") allEnums )
73 Just enums ->
74 case Map.lookup var enums of
75 Just bytes ->
76 ( bytes, allEnums )
78 Nothing ->
79 let
80 number =
81 LBS.toStrict $ BS.toLazyByteString $ BS.word8Dec $ fromIntegral (Map.size enums)
82 in
83 ( number, Map.insert word (Map.insert var number enums) allEnums )
87-- SYMBOL TABLE
90type Table =
91 Map.Map Text (Module.Raw, Text)
94importToTable :: Module.UserImport -> Table
95importToTable (A.A _ ( fullName, Module.ImportMethod maybeAlias exposed )) =
96 let
97 shortName =
98 case maybeAlias of
99 Just alias ->
100 alias
102 Nothing ->
103 if Module.isKernel fullName then
104 Module.getKernel fullName
105 else if Text.isInfixOf "." fullName then
106 error ("modules with dots in kernel code need an alias: " ++ show fullName)
107 else
108 fullName
110 toEntry value =
111 ( "__" <> shortName <> "_" <> value, ( fullName, value ) )
112 in
113 Map.fromList $ map toEntry $
114 concatMap entryToValues $ getExplicits exposed
117getExplicits :: Exposing.Exposing a -> [a]
118getExplicits exposed =
119 case exposed of
120 Exposing.Open ->
121 error "cannot have open imports in kernel code"
123 Exposing.Explicit entries ->
124 map A.drop entries
127entryToValues :: Exposing.Entry -> [Text]
128entryToValues entry =
129 case entry of
130 Exposing.Lower name ->
131 [name]
133 Exposing.Upper name ctors ->
134 maybe [name] getExplicits ctors