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