test/Grammar/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 Grammar.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.Parser.Haskell 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.Grammar 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     (trans (H.ValueCode 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     (trans (H.ValueCode 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   -- keyword s = P.try (P.string s P.*> notIdentLetter) P.*> whitespace
  94   notIdentLetter = P.negLook identLetter
  95   identLetter = P.satisfy
  96     (trans (H.ValueCode nandIdentLetter [||nandIdentLetter||]))
  97
  98   -- hexadecimal = P.oneOf "xX" P.*> number (P.oneOf (['a'..'f'] <> ['A'..'F'] <> ['0'..'9']))
  99   -- octal = P.oneOf "oO" P.*> number (P.oneOf ['0'..'7'])
 100
 101   symbol :: Char -> repr Char
 102   symbol c = P.char c P.<* whitespace
 103   parens :: repr a -> repr a
 104   parens = P.between (symbol '(') (symbol ')')
 105   brackets :: repr a -> repr a
 106   brackets = P.between (symbol '[') (symbol ']')
 107   braces :: repr a -> repr a
 108   braces = P.between (symbol '{') (symbol '}')
 109   semi :: repr Char
 110   semi = symbol ';'
 111   comma :: repr Char
 112   comma = symbol ','
 113   commaSep :: repr a -> repr ()
 114   commaSep p = P.optional (commaSep1 p)
 115   commaSep1 :: repr a -> repr ()
 116   commaSep1 p = p P.*> P.skipMany (comma P.*> p)
 117
 118   space :: repr ()
 119   space = P.void (P.satisfy
 120     (trans (H.ValueCode isSpace [||isSpace||])))
 121   whitespace :: repr ()
 122   whitespace = spaces
 123   -- whitespace = P.skipMany (spaces P.<|> oneLineComment)
 124   spaces :: repr ()
 125   spaces = P.skipSome space
 126   oneLineComment :: repr ()
 127   oneLineComment = P.void (P.string "//" P.*> P.skipMany (P.satisfy
 128     (trans (H.ValueCode (/= '\n') [||(/= '\n')||]))))