]> Git — Sourcephile - haskell/symantic-parser.git/blob - test/Parser/Nandlang.hs
machine: simplify a bit the horizon checking
[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 Symantic.Univariant.Trans
34 import qualified Symantic.Parser as P
35 import qualified Symantic.Parser.Haskell as H
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 Char repr =>
55 repr ()
56 nandlang = whitespace P.*> P.skipMany funcdef P.<* P.eof
57 where
58 index :: repr ()
59 index = brackets nat
60 identifier :: repr ()
61 identifier = P.try (identStart P.*> P.skipMany identLetter) P.*> whitespace
62 variable :: repr ()
63 variable = identifier P.*> P.optional index
64
65 literal :: repr ()
66 literal = bit P.<|> charLit
67
68 keyword :: String -> repr ()
69 keyword s = P.try (P.string s P.*> notIdentLetter) P.*> whitespace
70
71 identStart = P.satisfy
72 [P.ErrorItemLabel "identStart"]
73 (trans (H.ValueCode nandIdentStart [||nandIdentStart||]))
74 identLetter = P.satisfy
75 [P.ErrorItemLabel "identLetter"]
76 (trans (H.ValueCode nandIdentLetter [||nandIdentLetter||]))
77 notIdentLetter = P.negLook identLetter
78
79 bit :: repr ()
80 bit = (P.char '0' P.<|> P.char '1') P.*> whitespace
81
82 nat :: repr ()
83 nat = decimal
84
85 charLit :: repr ()
86 charLit = P.between (P.char '\'') (symbol '\'') charChar
87
88 charChar :: repr ()
89 charChar = P.void (P.satisfy
90 [P.ErrorItemLabel "Char"]
91 (trans (H.ValueCode nandStringLetter [||nandStringLetter||]))) P.<|> esc
92
93 esc :: repr ()
94 esc = P.char '\\' P.*> P.void (P.oneOf "0tnvfr")
95
96 expr :: repr ()
97 expr = nandexpr P.*> P.skipMany (symbol '!' P.*> nandexpr)
98
99 nandexpr :: repr ()
100 nandexpr = literal P.<|> funccallOrVar
101
102 funccallOrVar :: repr ()
103 funccallOrVar = identifier P.*> P.optional (parens exprlist P.<|> index)
104
105 exprlist = commaSep expr
106 exprlist1 = commaSep1 expr
107 varlist = commaSep variable
108 varlist1 = commaSep1 variable
109
110 funcparam = varlist P.*> P.optional (symbol ':' P.*> varlist)
111 varstmt = P.optional (keyword "var") P.*> varlist1 P.*> symbol '=' P.*> exprlist1 P.<* semi
112 ifstmt = keyword "if" P.*> expr P.*> block P.*> P.optional (keyword "else" P.*> block)
113 whilestmt = keyword "while" P.*> expr P.*> block
114 statement = ifstmt P.<|> whilestmt P.<|> P.try varstmt P.<|> expr P.<* semi
115 block = braces (P.skipMany statement)
116 funcdef = keyword "function" P.*> identifier P.*> parens funcparam P.*> block
117
118 decimal :: repr ()
119 decimal = number (P.oneOf ['0'..'9'])
120 hexadecimal = P.oneOf "xX" P.*> number (P.oneOf (['a'..'f'] <> ['A'..'F'] <> ['0'..'9']))
121 octal = P.oneOf "oO" P.*> number (P.oneOf ['0'..'7'])
122 number :: repr a -> repr ()
123 number digit = P.skipSome digit
124
125 symbol :: Char -> repr Char
126 symbol c = P.char c P.<* whitespace
127 parens :: repr a -> repr a
128 parens = P.between (symbol '(') (symbol ')')
129 brackets :: repr a -> repr a
130 brackets = P.between (symbol '[') (symbol ']')
131 braces :: repr a -> repr a
132 braces = P.between (symbol '{') (symbol '}')
133 semi :: repr Char
134 semi = symbol ';'
135 comma :: repr Char
136 comma = symbol ','
137 commaSep :: repr a -> repr ()
138 commaSep p = P.optional (commaSep1 p)
139 commaSep1 :: repr a -> repr ()
140 commaSep1 p = p P.*> P.skipMany (comma P.*> p)
141
142 space :: repr ()
143 space = P.void (P.satisfy
144 [P.ErrorItemLabel "space"]
145 (trans (H.ValueCode isSpace [||isSpace||])))
146 whitespace :: repr ()
147 whitespace = P.skipMany (spaces P.<|> oneLineComment)
148 spaces :: repr ()
149 spaces = P.skipSome space
150 oneLineComment :: repr ()
151 oneLineComment = P.void (P.string "//" P.*> P.skipMany (P.satisfy
152 [P.ErrorItemLabel "oneLineComment"]
153 (trans (H.ValueCode (/= '\n') [||(/= '\n')||]))))