parsers/Parsers/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 Parsers.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 qualified Symantic.Class as Prod
  21 import qualified Symantic.Parser as P
  22
  23 type Parser a = P.Parser Text.Text a
  24
  25 nandIdentStart :: Char -> Bool
  26 nandIdentStart c = isAlpha c || c == '_'
  27
  28 nandIdentLetter :: Char -> Bool
  29 nandIdentLetter c = isAlphaNum c || c == '_'
  30
  31 nandUnreservedName :: String -> Bool
  32 nandUnreservedName = \s -> not (Set.member s keys)
  33   where
  34   keys = Set.fromList ["if", "else", "while", "function", "var"]
  35
  36 nandStringLetter :: Char -> Bool
  37 nandStringLetter c = (c /= '"') && (c /= '\\') && (c > '\026')
  38
  39 grammar :: forall repr.
  40   P.Grammarable Char repr =>
  41   repr ()
  42 grammar = whitespace P.*> P.skipMany funcdef P.<* P.eof
  43   where
  44   literal :: repr ()
  45   literal = bit P.<|> charLit
  46   bit :: repr ()
  47   bit = (P.char '0' P.<|> P.char '1') P.*> whitespace
  48   charLit :: repr ()
  49   charLit = P.between (P.char '\'') (symbol '\'') charChar
  50   charChar :: repr ()
  51   charChar = P.void (P.satisfy
  52     (P.production nandStringLetter [||nandStringLetter||])) P.<|> esc
  53   esc :: repr ()
  54   esc = P.char '\\' P.*> P.void (P.oneOf "0tnvfr")
  55   expr :: repr ()
  56   expr = nandexpr P.*> P.skipMany (symbol '!' P.*> nandexpr)
  57   nandexpr :: repr ()
  58   nandexpr = literal P.<|> funccallOrVar
  59   funccallOrVar :: repr ()
  60   funccallOrVar = identifier P.*> P.optional (parens exprlist P.<|> index)
  61   identifier :: repr ()
  62   identifier = P.try (identStart P.*> P.skipMany identLetter) P.*> whitespace
  63   identStart = P.satisfy
  64     (P.production nandIdentStart [||nandIdentStart||])
  65
  66   exprlist  = commaSep expr
  67   exprlist1 = commaSep1 expr
  68   varlist   = commaSep variable
  69   varlist1  = commaSep1 variable
  70   variable :: repr ()
  71   variable = identifier P.*> P.optional index
  72   index :: repr ()
  73   index = brackets nat
  74   nat :: repr ()
  75   nat = decimal
  76   decimal :: repr ()
  77   decimal = number (P.oneOf ['0'..'9'])
  78   number :: repr a -> repr ()
  79   number digit = P.skipSome digit
  80
  81   funcdef = keyword "function" P.*> identifier P.*> parens funcparam P.*> block
  82   funcparam = varlist P.*> P.optional (symbol ':' P.*> varlist)
  83   block = braces (P.skipMany statement)
  84   statement =
  85     ifstmt P.<|> whilestmt P.<|> P.try varstmt P.<|> expr P.<* semi
  86     -- P.pure Prod.unit
  87   ifstmt = keyword "if" -- P.*> expr P.*> block P.*> P.optional (keyword "else" P.*> block)
  88   whilestmt = keyword "while" P.*> expr P.*> block
  89   varstmt = P.optional (keyword "var") P.*> varlist1 P.*> symbol '=' P.*> exprlist1 P.<* semi
  90   keyword :: String -> repr ()
  91   keyword k = P.string k P.*> P.pure Prod.unit
  92   {-
  93   keyword s = P.try (P.string s P.*> notIdentLetter) P.*> whitespace
  94   notIdentLetter = P.negLook identLetter
  95   -}
  96   identLetter = P.satisfy
  97     (P.production nandIdentLetter [||nandIdentLetter||])
  98
  99   -- hexadecimal = P.oneOf "xX" P.*> number (P.oneOf (['a'..'f'] <> ['A'..'F'] <> ['0'..'9']))
 100   -- octal = P.oneOf "oO" P.*> number (P.oneOf ['0'..'7'])
 101
 102   symbol :: Char -> repr Char
 103   symbol c = P.char c P.<* whitespace
 104   parens :: repr a -> repr a
 105   parens = P.between (symbol '(') (symbol ')')
 106   brackets :: repr a -> repr a
 107   brackets = P.between (symbol '[') (symbol ']')
 108   braces :: repr a -> repr a
 109   braces = P.between (symbol '{') (symbol '}')
 110   semi :: repr Char
 111   semi = symbol ';'
 112   comma :: repr Char
 113   comma = symbol ','
 114   commaSep :: repr a -> repr ()
 115   commaSep p = P.optional (commaSep1 p)
 116   commaSep1 :: repr a -> repr ()
 117   commaSep1 p = p P.*> P.skipMany (comma P.*> p)
 118
 119   space :: repr ()
 120   space = P.void (P.satisfy (P.production isSpace [||isSpace||]))
 121   whitespace :: repr ()
 122   whitespace = spaces
 123   {-
 124   whitespace = P.skipMany (spaces P.<|> oneLineComment)
 125   oneLineComment :: repr ()
 126   oneLineComment = P.void (P.string "//" P.*> P.skipMany (P.satisfy
 127     (P.production (/= '\n') [||(/= '\n')||])))
 128   -}
 129   spaces :: repr ()
 130   spaces = P.skipSome space