Nandlang.hs

{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UnboxedTuples #-}
module Parsers.Nandlang where

import Data.Bool
import Data.Char (isSpace, isAlpha, isAlphaNum)
import Data.Char (Char)
import Data.Eq (Eq(..))
import Data.Ord (Ord(..))
import Data.String (String)
import qualified Data.Set as Set
import qualified Data.Text as Text

import qualified Symantic.Parser as P
import qualified Symantic.Typed.Lang as Prod

type Parser a = P.Parser Text.Text a

nandIdentStart :: Char -> Bool
nandIdentStart c = isAlpha c || c == '_'

nandIdentLetter :: Char -> Bool
nandIdentLetter c = isAlphaNum c || c == '_'

nandUnreservedName :: String -> Bool
nandUnreservedName = \s -> not (Set.member s keys)
  where
  keys = Set.fromList ["if", "else", "while", "function", "var"]

nandStringLetter :: Char -> Bool
nandStringLetter c = (c /= '"') && (c /= '\\') && (c > '\026')

grammar :: forall repr.
  P.Grammarable Char repr =>
  repr ()
grammar = whitespace P.*> P.skipMany funcdef P.<* P.eof
  where
  literal :: repr ()
  literal = bit P.<|> charLit
  bit :: repr ()
  bit = (P.char '0' P.<|> P.char '1') P.*> whitespace
  charLit :: repr ()
  charLit = P.between (P.char '\'') (symbol '\'') charChar
  charChar :: repr ()
  charChar = P.void (P.satisfy
    (P.production nandStringLetter [||nandStringLetter||])) P.<|> esc
  esc :: repr ()
  esc = P.char '\\' P.*> P.void (P.oneOf "0tnvfr")
  expr :: repr ()
  expr = nandexpr P.*> P.skipMany (symbol '!' P.*> nandexpr)
  nandexpr :: repr ()
  nandexpr = literal P.<|> funccallOrVar
  funccallOrVar :: repr ()
  funccallOrVar = identifier P.*> P.optional (parens exprlist P.<|> index)
  identifier :: repr ()
  identifier = P.try (identStart P.*> P.skipMany identLetter) P.*> whitespace
  identStart = P.satisfy
    (P.production nandIdentStart [||nandIdentStart||])

  exprlist  = commaSep expr
  exprlist1 = commaSep1 expr
  varlist   = commaSep variable
  varlist1  = commaSep1 variable
  variable :: repr ()
  variable = identifier P.*> P.optional index
  index :: repr ()
  index = brackets nat
  nat :: repr ()
  nat = decimal
  decimal :: repr ()
  decimal = number (P.oneOf ['0'..'9'])
  number :: repr a -> repr ()
  number digit = P.skipSome digit

  funcdef = keyword "function" P.*> identifier P.*> parens funcparam P.*> block
  funcparam = varlist P.*> P.optional (symbol ':' P.*> varlist)
  block = braces (P.skipMany statement)
  statement =
    ifstmt P.<|> whilestmt P.<|> P.try varstmt P.<|> expr P.<* semi
    -- P.pure Prod.unit
  ifstmt = keyword "if" -- P.*> expr P.*> block P.*> P.optional (keyword "else" P.*> block)
  whilestmt = keyword "while" P.*> expr P.*> block
  varstmt = P.optional (keyword "var") P.*> varlist1 P.*> symbol '=' P.*> exprlist1 P.<* semi
  keyword :: String -> repr ()
  keyword k = P.string k P.*> P.pure Prod.unit
  {-
  keyword s = P.try (P.string s P.*> notIdentLetter) P.*> whitespace
  notIdentLetter = P.negLook identLetter
  -}
  identLetter = P.satisfy
    (P.production nandIdentLetter [||nandIdentLetter||])

  -- hexadecimal = P.oneOf "xX" P.*> number (P.oneOf (['a'..'f'] <> ['A'..'F'] <> ['0'..'9']))
  -- octal = P.oneOf "oO" P.*> number (P.oneOf ['0'..'7'])

  symbol :: Char -> repr Char
  symbol c = P.char c P.<* whitespace
  parens :: repr a -> repr a
  parens = P.between (symbol '(') (symbol ')')
  brackets :: repr a -> repr a
  brackets = P.between (symbol '[') (symbol ']')
  braces :: repr a -> repr a
  braces = P.between (symbol '{') (symbol '}')
  semi :: repr Char
  semi = symbol ';'
  comma :: repr Char
  comma = symbol ','
  commaSep :: repr a -> repr ()
  commaSep p = P.optional (commaSep1 p)
  commaSep1 :: repr a -> repr ()
  commaSep1 p = p P.*> P.skipMany (comma P.*> p)

  space :: repr ()
  space = P.void (P.satisfy (P.production isSpace [||isSpace||]))
  whitespace :: repr ()
  whitespace = spaces
  {-
  whitespace = P.skipMany (spaces P.<|> oneLineComment)
  oneLineComment :: repr ()
  oneLineComment = P.void (P.string "//" P.*> P.skipMany (P.satisfy
    (P.production (/= '\n') [||(/= '\n')||])))
  -}
  spaces :: repr ()
  spaces = P.skipSome space