gistfile1.fs

open System;

exception ParseError of string

(* A token represent a single element of the parse tree *)
type Token = 
    | EOFToken
    | NumberToken of double
    | IdentifierToken of string
    | OperatorToken of char
    | AssignmentToken
    | LeftParenToken
    | RightParenToken
    | NewlineToken
    | InvalidToken

(*
    lex parses a list of characters into a list of tokens
    acc should be [] when called
*)
let rec lex acc data : Token list =
    match data with
        | [] -> acc
        | c :: rest ->
            match c with
            | '(' -> lex (LeftParenToken :: acc) rest
            | ')' ->  lex (RightParenToken :: acc) rest
            | '=' -> lex (AssignmentToken :: acc) rest
            | '+' | '-' | '/' | '*' | '^' ->
                lex (OperatorToken(c) :: acc) rest
            | '.' | '0' | '1' | '2' | '3' | '4' | '5' | '6' | '7' | '8' | '9' ->
                readNum acc data
            | '\r' | '\n' ->
                lex (NewlineToken :: acc) rest
            | ' ' | '\t' ->
                lex acc rest
            | any ->
                if Char.IsLetter c then
                    readIdent acc data
                else
                    InvalidToken :: acc
and readNum acc data : Token list =
    let rec readNumInner (s : char list) data : (double * char list) =
        match data with
        | [] -> Double.Parse(String.Concat(Array.ofList(List.rev s))), []
        | c :: rest ->
            match c with
            | '.' | '0' | '1' | '2' | '3' | '4' | '5' | '6' | '7' | '8' | '9' ->
                readNumInner (c :: s) rest
            | any -> Double.Parse(String.Concat(Array.ofList(List.rev s))), data
    let tmp = readNumInner [] data
    lex (NumberToken(fst tmp) :: acc) (snd tmp)
and readIdent acc data : Token list =
    let rec readIdentInner (s : char list) data : (string * char list) =
        match data with
        | [] -> String.Concat(Array.ofList(List.rev s)), []
        | c :: rest ->
            if Char.IsLetterOrDigit c then
                readIdentInner (c :: s) rest
            else
                String.Concat(Array.ofList(List.rev s)), data
    let tmp = readIdentInner [] data
    lex (IdentifierToken(fst tmp) :: acc) (snd tmp)

(*
An expression is actually a tree structure of tokens and other expressions
SingleValue tokens are immediate values (and UnaryExpressions might as well be)
BinaryExpressions have a left and right to be evaluated before applying an
operand to the result of each
*)
type Expression =
    | NoValue
    | SingleValue of Token
    | UnaryExpression of Token * Expression
    | BinaryExpression of Expression * Token * Expression

let rec skipParens left right : (Token list * Token list) =
    match right with
    | RightParenToken :: rest -> List.append left [RightParenToken], rest
    | LeftParenToken :: rest ->
        let tmp = skipParens (List.append left [LeftParenToken]) rest
        skipParens (fst tmp) (snd tmp)
    | t :: rest -> 
        skipParens (List.append left [t]) rest
    | [] ->
        raise (ParseError("Unexpected EOF"))

(*
split should be called through splitExp, but it takes a list of
tokens, finds the rightmost operator with the lowest precedence,
and splits the tokens into two lists around that operator
*)
let rec split curr currVal left right bestLeft bestRight : (Token list * Token list) =
    match right with
    | t :: rest ->
        match t with
            | LeftParenToken ->
                let tmp = skipParens (List.append left [LeftParenToken]) rest
                split curr currVal (fst tmp) (snd tmp) bestLeft bestRight
            | RightParenToken ->
                raise (ParseError("Unexpected )"))
            | OperatorToken('^') ->
                if currVal <= 5 then
                    split t 5 (List.append left [t]) rest (List.append left [t]) rest
                else
                    split curr currVal (List.append left [t]) rest bestLeft bestRight
            | OperatorToken('*') | OperatorToken('/') ->
                if currVal <= 10 then
                    split t 10 (List.append left [t]) rest (List.append left [t]) rest
                else
                    split curr currVal (List.append left [t]) rest bestLeft bestRight
            | OperatorToken('+') | OperatorToken('-') ->
                if currVal <= 20 then
                    split t 20 (List.append left [t]) rest (List.append left [t]) rest
                else
                    split curr currVal (List.append left [t]) rest bestLeft bestRight
            | any -> split curr currVal (List.append left [t]) rest bestLeft bestRight
    | [] -> bestLeft, bestRight

let splitExp tokens : (Token list * Token list) =
    split InvalidToken 0 [] tokens tokens []

let rec slowLast<'a> acc l : ('a * 'a list) =
    match l with
    | [] -> Unchecked.defaultof<'a>, []
    | x :: [] -> x, acc
    | x :: xs -> slowLast (List.append acc [x]) xs
 
let rec isParenWrapped n tokens =
    if List.length tokens = 0 then
        false
    else
        match tokens.Head with
        | RightParenToken ->
            if n = 0 then
                tokens.Tail.Length = 0
            else
                isParenWrapped (n - 1) tokens.Tail
        | LeftParenToken -> isParenWrapped (n + 1) tokens.Tail
        | _ -> isParenWrapped n tokens.Tail

let rec parseExp (tokens : Token list) : Expression =
    if tokens.Length > 0 && tokens.Head = LeftParenToken && isParenWrapped 0 tokens.Tail then
       parseExp (snd (slowLast [] tokens.Tail))
    else if tokens.Length > 0 && (fst (slowLast [] tokens)) = NewlineToken then
       parseExp (snd (slowLast [] tokens))
    else
        let tmp = splitExp tokens
        match tmp with
        | [], [] -> NoValue
        | x :: [], [] -> SingleValue(x)
        | x :: [], y when x = OperatorToken('-') -> UnaryExpression(x, parseExp y)
        | x, [] | [], x ->
            raise (ParseError("unexpected state"))
        | x, y ->
            let tmp = slowLast [] x
            BinaryExpression(parseExp (snd tmp), fst tmp, parseExp y)

type Statement =
    | OutputStatement of Expression
    | AssignmentStatement of string * Expression

let rec parse assign acc tmp tokens : Statement list =
    match tokens with
    | [] ->
        if tmp = [] then
            acc
        else
            if assign = "" then
                List.append acc [OutputStatement(parseExp tmp)]
            else
                List.append acc [AssignmentStatement(assign, parseExp tmp)]
    | NewlineToken :: rest ->
        if tmp = [] then
            parse assign acc tmp rest
        else
            if assign = "" then
                parse "" (List.append acc [OutputStatement(parseExp tmp)]) [] rest
            else
                parse "" (List.append acc [AssignmentStatement(assign, parseExp tmp)]) [] rest
    | IdentifierToken(s) :: AssignmentToken :: rest ->
        if assign = "" && tmp = [] then
            parse s acc [] rest
        else
            raise (ParseError("Unexpected assignment"))
    | x :: xs ->
        parse assign acc (List.append tmp [x]) xs

let rec printExp prefix exp =
    match exp with
    | NoValue -> printfn ""
    | SingleValue(t) -> printfn "%s%A" prefix t
    | UnaryExpression(t, e) ->
        printfn "%s%A" prefix t
        printExp (prefix + "\t") e
    | BinaryExpression(l, t, r) ->
        printExp (prefix + "\t") l
        printfn "%s%A" prefix t
        printExp (prefix + "\t") r

let rec evalExp exp (store : System.Collections.Generic.Dictionary<string,double>) : double =
    match exp with
    | SingleValue(NumberToken(t)) -> t
    | SingleValue(IdentifierToken(t)) -> store.[t]
    | UnaryExpression(OperatorToken('-'), ex) -> -1.0 * (evalExp ex store)
    | BinaryExpression(ex1, OperatorToken(o), ex2) ->
        match o with
        | '+' -> (evalExp ex1 store) + (evalExp ex2 store)
        | '-' -> (evalExp ex1 store) - (evalExp ex2 store)
        | '*' -> (evalExp ex1 store) * (evalExp ex2 store)
        | '/' -> (evalExp ex1 store) / (evalExp ex2 store)
        | '^' -> (evalExp ex1 store) ** (evalExp ex2 store)
        | other -> raise (ParseError("Unknown operator"))
    | other -> raise (ParseError("Empty Expression"))

[<EntryPoint>]
let main argv =
    let store = new System.Collections.Generic.Dictionary<string,double> ()
    while true do
        try
            let st = List.head <| parse "" [] [] (List.rev (lex [] (List.ofArray (Console.ReadLine().ToCharArray()))))
            match st with
            | OutputStatement(ex) ->
                printfn "%F" <| evalExp ex store
            | AssignmentStatement(s, ex) ->
                store.[s] <- (evalExp ex store)
        with
            | e -> printfn "Couldn't evaluate"
    0