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 Parsers.Nandlang where
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
20 import Symantic.Univariant.Trans
21 import qualified Symantic.Parser as P
22 import qualified Symantic.Parser.Haskell as H
24 type Parser a = P.Parser Text.Text a
26 nandIdentStart :: Char -> Bool
27 nandIdentStart c = isAlpha c || c == '_'
29 nandIdentLetter :: Char -> Bool
30 nandIdentLetter c = isAlphaNum c || c == '_'
32 nandUnreservedName :: String -> Bool
33 nandUnreservedName = \s -> not (Set.member s keys)
35 keys = Set.fromList ["if", "else", "while", "function", "var"]
37 nandStringLetter :: Char -> Bool
38 nandStringLetter c = (c /= '"') && (c /= '\\') && (c > '\026')
40 grammar :: forall repr.
41 P.Grammarable Char repr =>
43 grammar = whitespace P.*> P.skipMany funcdef P.<* P.eof
46 literal = bit P.<|> charLit
48 bit = (P.char '0' P.<|> P.char '1') P.*> whitespace
50 charLit = P.between (P.char '\'') (symbol '\'') charChar
52 charChar = P.void (P.satisfy
53 (trans (H.ValueCode nandStringLetter [||nandStringLetter||]))) P.<|> esc
55 esc = P.char '\\' P.*> P.void (P.oneOf "0tnvfr")
57 expr = nandexpr P.*> P.skipMany (symbol '!' P.*> nandexpr)
59 nandexpr = literal P.<|> funccallOrVar
60 funccallOrVar :: repr ()
61 funccallOrVar = identifier P.*> P.optional (parens exprlist P.<|> index)
63 identifier = P.try (identStart P.*> P.skipMany identLetter) P.*> whitespace
64 identStart = P.satisfy
65 (trans (H.ValueCode nandIdentStart [||nandIdentStart||]))
67 exprlist = commaSep expr
68 exprlist1 = commaSep1 expr
69 varlist = commaSep variable
70 varlist1 = commaSep1 variable
72 variable = identifier P.*> P.optional index
78 decimal = number (P.oneOf ['0'..'9'])
79 number :: repr a -> repr ()
80 number digit = P.skipSome digit
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)
86 ifstmt P.<|> whilestmt P.<|> P.try varstmt P.<|> expr P.<* semi
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
94 keyword s = P.try (P.string s P.*> notIdentLetter) P.*> whitespace
95 notIdentLetter = P.negLook identLetter
97 identLetter = P.satisfy
98 (trans (H.ValueCode nandIdentLetter [||nandIdentLetter||]))
100 -- hexadecimal = P.oneOf "xX" P.*> number (P.oneOf (['a'..'f'] <> ['A'..'F'] <> ['0'..'9']))
101 -- octal = P.oneOf "oO" P.*> number (P.oneOf ['0'..'7'])
103 symbol :: Char -> repr Char
104 symbol c = P.char c P.<* whitespace
105 parens :: repr a -> repr a
106 parens = P.between (symbol '(') (symbol ')')
107 brackets :: repr a -> repr a
108 brackets = P.between (symbol '[') (symbol ']')
109 braces :: repr a -> repr a
110 braces = P.between (symbol '{') (symbol '}')
115 commaSep :: repr a -> repr ()
116 commaSep p = P.optional (commaSep1 p)
117 commaSep1 :: repr a -> repr ()
118 commaSep1 p = p P.*> P.skipMany (comma P.*> p)
121 space = P.void (P.satisfy
122 (trans (H.ValueCode isSpace [||isSpace||])))
123 whitespace :: repr ()
126 whitespace = P.skipMany (spaces P.<|> oneLineComment)
127 oneLineComment :: repr ()
128 oneLineComment = P.void (P.string "//" P.*> P.skipMany (P.satisfy
129 (trans (H.ValueCode (/= '\n') [||(/= '\n')||]))))
132 spaces = P.skipSome space