]> Git — Sourcephile - haskell/symantic-parser.git/blob - test/Grammar/Nandlang.hs
more on failures
[haskell/symantic-parser.git] / test / Grammar / 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 Grammar.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 grammar :: forall repr.
41 P.Grammar Char repr =>
42 repr ()
43 grammar = whitespace P.*> P.skipMany funcdef P.<* P.eof
44 where
45 literal :: repr ()
46 literal = bit P.<|> charLit
47 bit :: repr ()
48 bit = (P.char '0' P.<|> P.char '1') P.*> whitespace
49 charLit :: repr ()
50 charLit = P.between (P.char '\'') (symbol '\'') charChar
51 charChar :: repr ()
52 charChar = P.void (P.satisfy
53 (trans (H.ValueCode nandStringLetter [||nandStringLetter||]))) P.<|> esc
54 esc :: repr ()
55 esc = P.char '\\' P.*> P.void (P.oneOf "0tnvfr")
56 expr :: repr ()
57 expr = nandexpr P.*> P.skipMany (symbol '!' P.*> nandexpr)
58 nandexpr :: repr ()
59 nandexpr = literal P.<|> funccallOrVar
60 funccallOrVar :: repr ()
61 funccallOrVar = identifier P.*> P.optional (parens exprlist P.<|> index)
62 identifier :: repr ()
63 identifier = P.try (identStart P.*> P.skipMany identLetter) P.*> whitespace
64 identStart = P.satisfy
65 (trans (H.ValueCode nandIdentStart [||nandIdentStart||]))
66
67 exprlist = commaSep expr
68 exprlist1 = commaSep1 expr
69 varlist = commaSep variable
70 varlist1 = commaSep1 variable
71 variable :: repr ()
72 variable = identifier P.*> P.optional index
73 index :: repr ()
74 index = brackets nat
75 nat :: repr ()
76 nat = decimal
77 decimal :: repr ()
78 decimal = number (P.oneOf ['0'..'9'])
79 number :: repr a -> repr ()
80 number digit = P.skipSome digit
81
82 funcdef = keyword "function" P.*> identifier P.*> parens funcparam P.*> block
83 funcparam = varlist P.*> P.optional (symbol ':' P.*> varlist)
84 block = braces (P.skipMany statement)
85 statement =
86 ifstmt P.<|> whilestmt P.<|> P.try varstmt P.<|> expr P.<* semi
87 -- P.pure H.unit
88 ifstmt = keyword "if" -- P.*> expr P.*> block P.*> P.optional (keyword "else" P.*> block)
89 whilestmt = keyword "while" P.*> expr P.*> block
90 varstmt = P.optional (keyword "var") P.*> varlist1 P.*> symbol '=' P.*> exprlist1 P.<* semi
91 keyword :: String -> repr ()
92 keyword k = P.string k P.*> P.pure H.unit
93 -- keyword s = P.try (P.string s P.*> notIdentLetter) P.*> whitespace
94 notIdentLetter = P.negLook identLetter
95 identLetter = P.satisfy
96 (trans (H.ValueCode nandIdentLetter [||nandIdentLetter||]))
97
98 -- hexadecimal = P.oneOf "xX" P.*> number (P.oneOf (['a'..'f'] <> ['A'..'F'] <> ['0'..'9']))
99 -- octal = P.oneOf "oO" P.*> number (P.oneOf ['0'..'7'])
100
101 symbol :: Char -> repr Char
102 symbol c = P.char c P.<* whitespace
103 parens :: repr a -> repr a
104 parens = P.between (symbol '(') (symbol ')')
105 brackets :: repr a -> repr a
106 brackets = P.between (symbol '[') (symbol ']')
107 braces :: repr a -> repr a
108 braces = P.between (symbol '{') (symbol '}')
109 semi :: repr Char
110 semi = symbol ';'
111 comma :: repr Char
112 comma = symbol ','
113 commaSep :: repr a -> repr ()
114 commaSep p = P.optional (commaSep1 p)
115 commaSep1 :: repr a -> repr ()
116 commaSep1 p = p P.*> P.skipMany (comma P.*> p)
117
118 space :: repr ()
119 space = P.void (P.satisfy
120 (trans (H.ValueCode isSpace [||isSpace||])))
121 whitespace :: repr ()
122 whitespace = spaces
123 -- whitespace = P.skipMany (spaces P.<|> oneLineComment)
124 spaces :: repr ()
125 spaces = P.skipSome space
126 oneLineComment :: repr ()
127 oneLineComment = P.void (P.string "//" P.*> P.skipMany (P.satisfy
128 (trans (H.ValueCode (/= '\n') [||(/= '\n')||]))))