git.iko.soy/elk
on master help sign in
Properly handle enums in kernel code
01ff2a9Evan Czaplicki
src/Parse/Kernel.hs+43−9
compare with master
unifiedsplit
@@ -6,10 +6,14 @@ module Parse.Kernel
6 where
6 where
7
7
8
8
9+import qualified Data.ByteString as BS
10+import qualified Data.ByteString.Builder as BS
11+import qualified Data.ByteString.Lazy as LBS
9import qualified Data.Map as Map
12import qualified Data.Map as Map
10import Data.Monoid ((<>))
13import Data.Monoid ((<>))
11import Data.Text (Text)
14import Data.Text (Text)
12import qualified Data.Text as Text
15import qualified Data.Text as Text
16+import Data.Word (Word8)
13
17
14import qualified AST.Exposing as Exposing
18import qualified AST.Exposing as Exposing
15import qualified AST.Kernel as Kernel
19import qualified AST.Kernel as Kernel
@@ -29,24 +33,54 @@ parser :: Parser Kernel.Info
29parser =
33parser =
30 do imports <- Parse.kernelHeader
34 do imports <- Parse.kernelHeader
31 let table = Map.unions (map importToTable imports)
35 let table = Map.unions (map importToTable imports)
32− chunks <- parserHelp table []
36+ chunks <- parserHelp table Map.empty []
33 return (Kernel.Info (Map.elems table) chunks)
37 return (Kernel.Info (Map.elems table) chunks)
34
38
35
39
36−parserHelp :: Table -> [Kernel.Chunk] -> Parser [Kernel.Chunk]
40+type Enums =
37−parserHelp table chunks =
41+ Map.Map Word8 (Map.Map Text BS.ByteString)
38− do chunk <- Parse.kernelChunk
39− case chunk of
40− Left js ->
41− return (Kernel.JS js : chunks)
42
42
43− Right (js, var) ->
43+
44+parserHelp :: Table -> Enums -> [Kernel.Chunk] -> Parser [Kernel.Chunk]
45+parserHelp table enums chunks =
46+ do (javascript, maybeMore) <- Parse.kernelChunk
47+ case maybeMore of
48+ Nothing ->
49+ return (Kernel.JS javascript : chunks)
50+
51+ Just (Parse.KernelImport, var) ->
44 case Map.lookup var table of
52 case Map.lookup var table of
45 Nothing ->
53 Nothing ->
46 error $ show $ "could not find " <> var <> " when parsing kernel code"
54 error $ show $ "could not find " <> var <> " when parsing kernel code"
47
55
48 Just (home, name) ->
56 Just (home, name) ->
49− parserHelp table (Kernel.Var home name : Kernel.JS js : chunks)
57+ parserHelp table enums (Kernel.Var home name : Kernel.JS javascript : chunks)
58+
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)
65+
66+
67+lookupEnum :: Word8 -> Text -> Enums -> (BS.ByteString, Enums)
68+lookupEnum word var allEnums =
69+ case Map.lookup word allEnums of
70+ Nothing ->
71+ ( "0", Map.insert word (Map.singleton var "0") allEnums )
72+
73+ Just enums ->
74+ case Map.lookup var enums of
75+ Just bytes ->
76+ ( bytes, allEnums )
77+
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 )
50
84
51
85
52
86
src/Parse/Primitives.hs+38−28
@@ -15,7 +15,7 @@ module Parse.Primitives
15 , string, character
15 , string, character
16 , digit, number
16 , digit, number
17 , shaderSource, shaderFailure
17 , shaderSource, shaderFailure
18− , kernelChunk
18+ , kernelChunk, ChunkTag(..)
19 )
19 )
20 where
20 where
21
21
@@ -36,7 +36,7 @@ import qualified Data.Text.Lazy as LT
36import qualified Data.Text.Lazy.Builder as LB
36import qualified Data.Text.Lazy.Builder as LB
37import Data.Text.Internal.Encoding.Utf16 (chr2)
37import Data.Text.Internal.Encoding.Utf16 (chr2)
38import Data.Text.Internal.Unsafe.Char (unsafeChr)
38import Data.Text.Internal.Unsafe.Char (unsafeChr)
39−import GHC.Word (Word16(..))
39+import GHC.Word (Word8, Word16)
40
40
41import qualified AST.Helpers as Help (isSymbol)
41import qualified AST.Helpers as Help (isSymbol)
42import qualified AST.Literal as L
42import qualified AST.Literal as L
@@ -1029,7 +1029,7 @@ digit =
1029 in
1029 in
1030 if isDigit word then
1030 if isDigit word then
1031 cok
1031 cok
1032− (fromIntegral (word - 0x0030))
1032+ (fromIntegral (word - 0x0030 {- 0 -}))
1033 (State array (offset + 1) (length - 1) indent row (col + 1) ctx)
1033 (State array (offset + 1) (length - 1) indent row (col + 1) ctx)
1034 noError
1034 noError
1035 else
1035 else
@@ -1307,50 +1307,52 @@ eatShader array offset length row col =
1307-- KERNEL CHOMP
1307-- KERNEL CHOMP
1308
1308
1309
1309
1310+data ChunkTag = KernelEnum Word8 | KernelImport
1311+
1312+
1310−kernelChunk :: Parser (Either BS.ByteString (BS.ByteString, Text))
1313+kernelChunk :: Parser (BS.ByteString, Maybe (ChunkTag, Text))
1311kernelChunk =
1314kernelChunk =
1312 Parser $ \(State array offset length indent row col ctx) cok _ _ _ ->
1315 Parser $ \(State array offset length indent row col ctx) cok _ _ _ ->
1313 let
1316 let
1314− (# isAtUnderscores, newOffset, newLength, newRow, newCol #) =
1317+ (# maybeChunkTag, newOffset, newLength, newRow, newCol #) =
1315 kernelChunkHelp array offset length row col
1318 kernelChunkHelp array offset length row col
1316
1319
1317 javascript =
1320 javascript =
1318 Text.encodeUtf8 (Text.Text array offset (newOffset - offset))
1321 Text.encodeUtf8 (Text.Text array offset (newOffset - offset))
1319 in
1322 in
1320− if not isAtUnderscores then
1323+ case maybeChunkTag of
1321−
1324+ Nothing ->
1322− let
1325+ let
1323− !newState =
1326+ !newState =
1324− State array newOffset newLength indent newRow newCol ctx
1327+ State array newOffset newLength indent newRow newCol ctx
1325− in
1328+ in
1326− cok (Left javascript) newState noError
1329+ cok (javascript, Nothing) newState noError
1327−
1328− else
1329
1330
1331+ Just tag ->
1330− let
1332+ let
1331− (# newerOffset, newerLength, newerCol #) =
1333+ (# newerOffset, newerLength, newerCol #) =
1332− varPrimHelp array newOffset newLength newCol
1334+ varPrimHelp array newOffset newLength newCol
1333
1335
1334− !newState =
1336+ !newState =
1335− State array newerOffset newerLength indent newRow newerCol ctx
1337+ State array newerOffset newerLength indent newRow newerCol ctx
1336
1338
1337− !kernelSymbol =
1339+ !kernelSymbol =
1338− Text.Text array newOffset (newerOffset - newOffset)
1340+ Text.Text array newOffset (newerOffset - newOffset)
1339− in
1341+ in
1340− cok (Right (javascript, kernelSymbol)) newState noError
1342+ cok (javascript, Just (tag, kernelSymbol)) newState noError
1341
1343
1342
1344
1343−kernelChunkHelp :: Text.Array -> Int -> Int -> Int -> Int -> (# Bool, Int, Int, Int, Int #)
1345+kernelChunkHelp :: Text.Array -> Int -> Int -> Int -> Int -> (# Maybe ChunkTag, Int, Int, Int, Int #)
1344kernelChunkHelp array offset length row col =
1346kernelChunkHelp array offset length row col =
1345− if length < 2 then
1347+ if length == 0 then
1346− (# False, offset, length, row, col #)
1348+ (# Nothing, offset, length, row, col #)
1347
1349
1348 else
1350 else
1349 let
1351 let
1350 !word = Text.unsafeIndex array offset
1352 !word = Text.unsafeIndex array offset
1351 in
1353 in
1352− if word == 0x005F {- _ -} && Text.unsafeIndex array (offset + 1) == 0x005F {- _ -} then
1354+ if word == 0x005F {- _ -} && length > 3 && Text.unsafeIndex array (offset + 1) == 0x005F {- _ -} then
1353− (# True, offset, length, row, col #)
1355+ (# Just (toChunkTag (Text.unsafeIndex array (offset + 2))), offset, length, row, col #)
1354
1356
1355 else if word == 0x000A {- \n -} then
1357 else if word == 0x000A {- \n -} then
1356 kernelChunkHelp array (offset + 1) (length - 1) (row + 1) 1
1358 kernelChunkHelp array (offset + 1) (length - 1) (row + 1) 1
@@ -1360,3 +1362,11 @@ kernelChunkHelp array offset length row col =
1360
1362
1361 else
1363 else
1362 kernelChunkHelp array (offset + 2) (length - 2) row (col + 1)
1364 kernelChunkHelp array (offset + 2) (length - 2) row (col + 1)
1365+
1366+
1367+toChunkTag :: Word16 -> ChunkTag
1368+toChunkTag word =
1369+ if isDigit word then
1370+ KernelEnum (fromIntegral (word - 0x0030 {- 0 -}))
1371+ else
1372+ KernelImport