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 Symantic.Univariant.Trans
  21 import qualified Symantic.Parser as P
  22 import qualified Symantic.Univariant.Lang 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.Grammarable 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     (P.production 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     (P.production 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   {-
  94   keyword s = P.try (P.string s P.*> notIdentLetter) P.*> whitespace
  95   notIdentLetter = P.negLook identLetter
  96   -}
  97   identLetter = P.satisfy
  98     (P.production nandIdentLetter [||nandIdentLetter||])
  99
 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'])
 102
 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 '}')
 111   semi :: repr Char
 112   semi = symbol ';'
 113   comma :: repr Char
 114   comma = 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)
 119
 120   space :: repr ()
 121   space = P.void (P.satisfy (P.production isSpace [||isSpace||]))
 122   whitespace :: repr ()
 123   whitespace = spaces
 124   {-
 125   whitespace = P.skipMany (spaces P.<|> oneLineComment)
 126   oneLineComment :: repr ()
 127   oneLineComment = P.void (P.string "//" P.*> P.skipMany (P.satisfy
 128     (P.production (/= '\n') [||(/= '\n')||])))
 129   -}
 130   spaces :: repr ()
 131   spaces = P.skipSome space