open Parser
open AST
open Tokenizer
open System
open System.Globalization
let isSpace = (['\n';'\r';'\t';' '] |> Set.ofList).Contains
let isDigit = (['0'..'9'] |> Set.ofList).Contains
let isHexDigit = ((['a'..'f'] @ ['A'..'F'] @ ['0'..'9']) |> Set.ofList).Contains
let isStrChar c = (c <> '\"') && (c <> '\\')
let isEscChar = (['\"';'\\';'/';'b';'f';'n';'r';'t'] |> Set.ofList).Contains
let space = (token("space") { return! isSpace }).Repeat
let letters = (token("letter") { return! Char.IsLetter }).Repeat
let digits = (token("digit") { return! isDigit }).Repeat
let underscores = (token("_") {return! (=) '='}).Repeat
let hexDigits = (token("hexdigit") { return! isHexDigit }).Repeat
let opCode x = token(x) {
let! _ = space.OrNothing
let! _ = x
let! _ = space.OrNothing
return x
}
let opEnd x = token(x) {
let! _ = space.OrNothing
let! _ = x
return x
}
let keyword str = token(str) { return! str }
let expparser = parser("expression")
let pIdentifier =
let pa = parser("identifier") {
let! l,s1 = underscores
let! _,s2 = (letters <|> digits).Repeat
let! _,s3 = (letters <|> digits <|> underscores).Repeat.OrNothing
return s1 + s2 + s3
}
let pb = parser("identifier") {
let! l,s1 = letters
let! _,s2 = (letters <|> digits <|> underscores).Repeat.OrNothing
return s1 + s2
}
pa <|> pb
//helper function to create a parser for operators
let private makeOp x y =
expparser {
let! _ = opCode x
return y
}
//create parsers for our binary operatores
let private pBinOps =
makeOp "*" MyBinaryOperator.Mul <|>
makeOp "/" MyBinaryOperator.Div <|>
makeOp "%" MyBinaryOperator.Mod <|>
makeOp "+" MyBinaryOperator.Add <|>
makeOp "-" MyBinaryOperator.Sub <|>
makeOp "<=" MyBinaryOperator.LEqual <|>
makeOp "<" MyBinaryOperator.Less <|>
makeOp ">=" MyBinaryOperator.GEqual <|>
makeOp ">" MyBinaryOperator.Greater <|>
makeOp "==" MyBinaryOperator.Equal <|>
makeOp "!=" MyBinaryOperator.NEqual <|>
makeOp "&&" MyBinaryOperator.And <|>
makeOp "||" MyBinaryOperator.Or <|>
makeOp "&" MyBinaryOperator.BitAnd <|>
makeOp "^" MyBinaryOperator.BitXOr <|>
makeOp "|" MyBinaryOperator.BitOr
//get the weight of a binary operator
//lower values have a higher precedence
let private wBinOps = function
| MyBinaryOperator.Mul -> 1000
| MyBinaryOperator.Div -> 1000
| MyBinaryOperator.Mod -> 1000
| MyBinaryOperator.Add -> 2000
| MyBinaryOperator.Sub -> 2000
| MyBinaryOperator.Less -> 3000
| MyBinaryOperator.Greater -> 3000
| MyBinaryOperator.LEqual -> 3000
| MyBinaryOperator.GEqual -> 3000
| MyBinaryOperator.Equal -> 4000
| MyBinaryOperator.NEqual -> 4000
| MyBinaryOperator.BitAnd -> 5000
| MyBinaryOperator.BitXOr -> 6000
| MyBinaryOperator.BitOr -> 7000
| MyBinaryOperator.And -> 8000
| MyBinaryOperator.Or -> 9000
//shunt our binary expression into form that
//can easily be transformed to asm
let rec private sBinOps op a = function
| MyExpression.Binary(xb,xop,xc) as b ->
if((wBinOps op) < (wBinOps xop)) then
let c = MyExpression.Binary(a,op,xb)
sBinOps xop c xc
else
MyExpression.Binary(a,op,b)
| b -> MyExpression.Binary(a,op,b)
//helper parser for escape sequences in strings.
let private escChar =
let replaceEscChar = function 'b' -> '\b' | 'f' -> '\f' | 'n' -> '\n'
| 'r' -> '\r'| 't' -> '\t' | other -> other
let simple = token("char"){
let! _ = (=) '\\'
let! c = isEscChar
return new string [|for x in c -> replaceEscChar x |]
}
let unicode = token("char") {
let! _ = "\\u"
let! d1 = isHexDigit
let! d2 = isHexDigit
let! d3 = isHexDigit
let! d4 = isHexDigit
let r =
let s = d1 + d2 + d3 + d4
Byte.Parse(s, Globalization.NumberStyles.HexNumber)
|> char
return r.ToString()
}
expparser {
let! l,c = unicode <|> simple <|> token("char") { return! isStrChar }
return c.Chars 0
}
let rec pExpression : Parser<MyExpression> =
let p = //parse unary expressions, note that this will give unary expression higher precedence than post-fix
expparser {
let! _ = opCode "(" //parenthesis
let! x = pExpression
let! _ = opCode ")"
return MyExpression.Unary(MyUnaryOperator.Parent,x)
} <|> expparser {
let! _ = opCode "!" //not operator
let! x = pExpression
return MyExpression.Unary(MyUnaryOperator.Not,x)
} <|> expparser {
let! _ = opCode "-" //unary minus operator for negative values
let! x = pExpression
return MyExpression.Unary(MyUnaryOperator.Minus,x)
}
//parse integer constants
let i =
let x = expparser { //integers are a sequence of digits
let! l,i = digits
let b,x = UInt64.TryParse(i)
if b then return MyExpression.Integer x
}
let y = expparser { //or a sequence of hex-digits after "0x" or "0X"
let! _ = keyword "0x" <|> keyword "0X"
let! l,h = hexDigits
let b,x = UInt64.TryParse(h,NumberStyles.HexNumber,CultureInfo.InvariantCulture)
if b then return MyExpression.Integer x
}
x <|> y
//parse float constants
let f =
let frac = token("frac") { //a sequence of digits with "." and another sequence of digits
let! x = digits
let! y = "."
let! z = digits
return x+y + z
}
let exp = token("exp") { //the exponent part of a float
let! e = keyword("e") <|> keyword("E")
let! s = (keyword("+") <|> keyword("-")).OrNothing
let! d = digits
return e+s+d
}
expparser {
let! _,f = frac //must either be a frac number with optional exponent
let! _,e = exp.OrNothing
let b,x = Double.TryParse(f+e)
if b then return MyExpression.Float x
} <|> expparser { //or a normal integral with an exponent
let! _,d = digits
let! _,e = exp
let b,x = Double.TryParse(d+e)
if b then return MyExpression.Float x
}
//parse string constants
let s =
expparser {
let! _ = keyword("\"")
let! s = escChar.Repeat
let! _ = keyword("\"")
return MyExpression.String(new string (Array.ofList s))
}
//parse boolean constants
let b =
expparser {
let! _ = keyword "true"
return MyExpression.Boolean true
} <|> expparser {
let! _ = keyword "false"
return MyExpression.Boolean false
}
//parse identifier constants (identity)
let v = expparser {
let! id = pIdentifier
return MyExpression.Identity id
}
//parse null-constants
let n = expparser {
let! _ = keyword "null"
return MyExpression.Null
}
//helper function to handle ambigeous syntax for tuple, call and array-literal
let expand = function
| MyExpression.Tuple(args) -> args //if previous expression was tuple, convert to list
| arg -> [arg] //otherwise create a list with just the argument
//parse postfix expression
let rec postfix (exp:MyExpression) : Parser<MyExpression> =
expparser {
let! _ = opCode "[" //array indexer; must have just 1 argument
let! i = pExpression
let! _ = opEnd "]"
return! postfix(MyExpression.Postfix(MyPostfixOperator.Array i,exp))
} <|> expparser {
let! _ = opCode "(" //call without arguments
let! _ = opEnd ")"
return! postfix(MyExpression.Postfix(MyPostfixOperator.Call [],exp))
} <|> expparser {
let! _ = opCode "(" //call with arguments
let! xa = pExpression //check for tuple to get multiple arguments
let! _ = opEnd ")"
return! postfix(MyExpression.Postfix(MyPostfixOperator.Call(expand xa),exp))
} <|> expparser {
let! _ = opCode "." //member expression
let! s = pIdentifier
return! postfix(MyExpression.Postfix(MyPostfixOperator.Member s,exp))
} <|> expparser { return exp }
//member assigment for object literal
let m = typeparser { // <identifier> : <typename>
let! _ = space.OrNothing
let! n = pIdentifier
let! _ = opCode ":"
let! t = pExpression
let! _,eol = space <|> opCode ";"
if eol = ";" then return n,t
else if eol.Contains "\n" then return n,t
}
//parse object literal
let o =
typeparser {
let! _ = opCode "{" //empty objects
let! _ = opEnd "}"
return MyExpression.Object(Map.empty)
} <|> typeparser {
let! _ = opCode "{" //object with many assignments
let! ms = m.Repeat
let! _ = opEnd "}"
return MyExpression.Object(Map.ofList ms)
}
//parse array literal
let a =
typeparser {
let! _ = opCode "[" //empty array
let! _ = opEnd "]"
return MyExpression.Array([])
} <|> typeparser {
let! _ = opCode "[" //array with values
let! xa = pExpression //check for tuple to get multiple values
let! _ = opCode "]"
return MyExpression.Array(expand xa)
}
//loop-parse binary expression
let rec binary (exp:MyExpression) : Parser<MyExpression> =
expparser {
let! o = pBinOps //get one binary operator
let! other = pExpression //right-hand expression
return! binary(sBinOps o exp other) //shunt operator and get next expression
} <|> expparser { return exp } //or return the current expression
//primary expressions are constants, identifier, literals or unary expressions
let primary = expparser {
let! x = f <|> i <|> s <|> p <|> v <|> n <|> o <|> a
return! postfix x //wrap result into post-fix expressions
}
let px = expparser { //wrap result into binary expressions
let! x = primary
return! binary x
}
expparser { //finally try to create a tuple, so this one always has the highest precedence
let! xs = px.SeparatedBy(opCode ",")
if xs.Length > 1 then return MyExpression.Tuple xs
else if xs.Length = 1 then return xs.Head
}