]> Git — Sourcephile - haskell/symantic-parser.git/blob - test/Parser/Nandlang.hs
machine: map exceptionStack by label
[haskell/symantic-parser.git] / test / Parser / Nandlang.hs
1 {-# LANGUAGE DeriveLift #-}
2 {-# LANGUAGE FlexibleContexts #-}
3 {-# LANGUAGE NoMonomorphismRestriction #-}
4 {-# LANGUAGE Rank2Types #-}
5 {-# LANGUAGE ScopedTypeVariables #-}
6 {-# LANGUAGE StandaloneDeriving #-}
7 {-# LANGUAGE TemplateHaskell #-}
8 {-# LANGUAGE UnboxedTuples #-}
9 module Parser.Nandlang where
10
11 import Data.Bool
12 import Data.Char (isSpace, isAlpha, isAlphaNum)
13 import Data.Char (Char)
14 import Data.Eq (Eq(..))
15 import Data.Ord (Ord(..))
16 import Data.String (String)
17 import qualified Data.Set as Set
18 import qualified Data.Text as Text
19
20 import Symantic.Univariant.Trans
21 import qualified Symantic.Parser as P
22 import qualified Symantic.Parser.Haskell as H
23
24 type Parser a = P.Parser Text.Text a
25
26 nandIdentStart :: Char -> Bool
27 nandIdentStart c = isAlpha c || c == '_'
28
29 nandIdentLetter :: Char -> Bool
30 nandIdentLetter c = isAlphaNum c || c == '_'
31
32 nandUnreservedName :: String -> Bool
33 nandUnreservedName = \s -> not (Set.member s keys)
34 where
35 keys = Set.fromList ["if", "else", "while", "function", "var"]
36
37 nandStringLetter :: Char -> Bool
38 nandStringLetter c = (c /= '"') && (c /= '\\') && (c > '\026')
39
40 nandlang :: forall repr.
41 P.Grammar Char repr =>
42 repr ()
43 nandlang = whitespace P.*> P.skipMany funcdef P.<* P.eof
44 where
45 index :: repr ()
46 index = brackets nat
47 identifier :: repr ()
48 identifier = P.try (identStart P.*> P.skipMany identLetter) P.*> whitespace
49 variable :: repr ()
50 variable = identifier P.*> P.optional index
51
52 literal :: repr ()
53 literal = bit P.<|> charLit
54
55 keyword :: String -> repr ()
56 keyword s = P.try (P.string s P.*> notIdentLetter) P.*> whitespace
57
58 identStart = P.satisfy
59 [P.ErrorItemLabel "identStart"]
60 (trans (H.ValueCode nandIdentStart [||nandIdentStart||]))
61 identLetter = P.satisfy
62 [P.ErrorItemLabel "identLetter"]
63 (trans (H.ValueCode nandIdentLetter [||nandIdentLetter||]))
64 notIdentLetter = P.negLook identLetter
65
66 bit :: repr ()
67 bit = (P.char '0' P.<|> P.char '1') P.*> whitespace
68
69 nat :: repr ()
70 nat = decimal
71
72 charLit :: repr ()
73 charLit = P.between (P.char '\'') (symbol '\'') charChar
74
75 charChar :: repr ()
76 charChar = P.void (P.satisfy
77 [P.ErrorItemLabel "Char"]
78 (trans (H.ValueCode nandStringLetter [||nandStringLetter||]))) P.<|> esc
79
80 esc :: repr ()
81 esc = P.char '\\' P.*> P.void (P.oneOf "0tnvfr")
82
83 expr :: repr ()
84 expr = nandexpr P.*> P.skipMany (symbol '!' P.*> nandexpr)
85
86 nandexpr :: repr ()
87 nandexpr = literal P.<|> funccallOrVar
88
89 funccallOrVar :: repr ()
90 funccallOrVar = identifier P.*> P.optional (parens exprlist P.<|> index)
91
92 exprlist = commaSep expr
93 exprlist1 = commaSep1 expr
94 varlist = commaSep variable
95 varlist1 = commaSep1 variable
96
97 funcparam = varlist P.*> P.optional (symbol ':' P.*> varlist)
98 varstmt = P.optional (keyword "var") P.*> varlist1 P.*> symbol '=' P.*> exprlist1 P.<* semi
99 ifstmt = keyword "if" P.*> expr P.*> block P.*> P.optional (keyword "else" P.*> block)
100 whilestmt = keyword "while" P.*> expr P.*> block
101 statement = ifstmt P.<|> whilestmt P.<|> P.try varstmt P.<|> expr P.<* semi
102 block = braces (P.skipMany statement)
103 funcdef = keyword "function" P.*> identifier P.*> parens funcparam P.*> block
104
105 decimal :: repr ()
106 decimal = number (P.oneOf ['0'..'9'])
107 -- hexadecimal = P.oneOf "xX" P.*> number (P.oneOf (['a'..'f'] <> ['A'..'F'] <> ['0'..'9']))
108 -- octal = P.oneOf "oO" P.*> number (P.oneOf ['0'..'7'])
109 number :: repr a -> repr ()
110 number digit = P.skipSome digit
111
112 symbol :: Char -> repr Char
113 symbol c = P.char c P.<* whitespace
114 parens :: repr a -> repr a
115 parens = P.between (symbol '(') (symbol ')')
116 brackets :: repr a -> repr a
117 brackets = P.between (symbol '[') (symbol ']')
118 braces :: repr a -> repr a
119 braces = P.between (symbol '{') (symbol '}')
120 semi :: repr Char
121 semi = symbol ';'
122 comma :: repr Char
123 comma = symbol ','
124 commaSep :: repr a -> repr ()
125 commaSep p = P.optional (commaSep1 p)
126 commaSep1 :: repr a -> repr ()
127 commaSep1 p = p P.*> P.skipMany (comma P.*> p)
128
129 space :: repr ()
130 space = P.void (P.satisfy
131 [P.ErrorItemLabel "space"]
132 (trans (H.ValueCode isSpace [||isSpace||])))
133 whitespace :: repr ()
134 whitespace = P.skipMany (spaces P.<|> oneLineComment)
135 spaces :: repr ()
136 spaces = P.skipSome space
137 oneLineComment :: repr ()
138 oneLineComment = P.void (P.string "//" P.*> P.skipMany (P.satisfy
139 [P.ErrorItemLabel "oneLineComment"]
140 (trans (H.ValueCode (/= '\n') [||(/= '\n')||]))))