// shift-reduce parser and evaluater for online calculator (* Ambiguous context-free grammer: E := var of string | val of float | E + E | E * E | E - E | E / E | (E);; - E; // unary minus - reduce-reduce precedence //( will have highest precedence - reduce, don't shift negative values will be handled by the tokenizer input stream of tokens will be represented as an array, from C# program global index will point to the next token. parse stack will be a list of expressions, starting with empty stack. left-side is tos so read parse stack backwards. New Edition Fall 2017: code reorganized, abstract syntax expanded to allow future extensions. eval procedure takes a Dictionary as binding environment for the evaluation of variables. Some procedures became mutables so AOP style "advice" can be written modularly. Expressions (x=3:x+x) means let x=3 in x+x, which returns 6. "Let" is a ternary operation that takes a var, a expression to bind to, and an expression to evaluate under the binding. However, base program does not recognize scope of let properly: (x=3:(x=4:x+x)+x) will return 12, but should return 11! Students must fix this! Note: the lexical analyzer is not capable of distinguishing between "=" and "==" as separate tokens. Use keyword "eq" or some other token for boolean equality. *) open System;; open Microsoft.FSharp.Math;; open System.Text.RegularExpressions;; open System.Collections.Generic;; ///////////////// Lexical Symbol Specification // use regular expression to represent possible operator symbols: let mutable operators = "([()\+\-\*/:;,]|\s|\[|\]|=)";; let mutable keywords = ["if";"while";"let";"eq";"printnum";"printchr";"begin";"end"]; // keywords not currently used. // use hash table (Dictionary) to associate each operator with precedence let prectable = Dictionary();; prectable.["+"] <- 200; prectable.["-"] <- 300; prectable.["*"] <- 400; prectable.["/"] <- 500; prectable.["("] <- 990; prectable.[")"] <- 20; prectable.[":"] <- 20; prectable.["="] <- 20; // function to add new operator (as regex string) with precedence (int) let newoperator (s:string) prec = let n = operators.Length let prefix = operators.Substring(0,n-1) operators <- prefix + "|" + s + ")" if s.[0]='\\' then prectable.[s.Substring(1,s.Length-1)] <- prec else prectable.[s] <- prec;; //sample usage of newoperator function: //newoperator @"&&" 650;; // use @ before string or use "\^" (explict escape) //Console.WriteLine(string(prectable.["&&"]));; // check if success // newoperator "^" 600;; // @"^" didn't work - don't know why // need newoperator "\?" precedence level // need newoperator "%" precedence level ////////////// Lexical Token stream and abstract syntax combined into expr // Abstract Syntax (not all cases used in this program) type expr = | Val of int | Binop of (string*expr*expr) | Uniop of (string*expr) | Var of string | Ternop of string*expr*expr*expr | Seq of (expr list) | Sym of string | EOF ;; // Proper expression check (shallow): separates proper expression from tokens // This is the price to pay for using strings: no compile-time verification let proper = function | Binop(s,_,_) when prectable.ContainsKey(s) -> true | Ternop(s,_,_,_) when prectable.ContainsKey(s) -> true | Uniop(s,_) when prectable.ContainsKey(s) -> true | Binop(_,_,_) -> false; | Uniop(_,_) -> false; | Ternop("let",Var(x),_,_) -> true | Sym(_) -> false | EOF -> false | _ -> true;; // because of variables, env represents bindings for variables. // eval is mutable so we can inject behaviors later... // mutable funs can't be recursive calls, unless we declare eval first: let mutable eval = fun (env:Dictionary) (exp:expr) -> 0;; eval <- fun (env:Dictionary) exp -> match exp with | Val(v) -> v | Binop("+",a,b) -> (eval env a) + (eval env b) // not Plus(a,b) | Binop("*",a,b) -> (eval env a) * (eval env b) // lose some static safety | Binop("-",a,b) -> (eval env a) - (eval env b) | Binop("/",a,b) -> (eval env a) / (eval env b) // | Binop("^",a,b) -> int(Math.Pow(float(eval env a),float(eval env b))) | Uniop("-",a) -> -1 * (eval env a) | Ternop("let",Var(x),e1,e2) -> env.[x] <- (eval env e1) // bind x to value, store in env eval env e2 | Var(s) -> env.[s] | Seq([e]) -> eval env e | Seq(a::b::c) -> ignore (eval env a) // ignore required to ignore return value eval env (Seq(b::c)) | x -> raise (Exception("unrecognized eval case: "+string(x)));; //////////////////////////////////////////////////// ////////////// LEXICAL ANALYSER (LEXER) Console.Write("Enter expression to be evaluated: ");; let inp = Console.ReadLine();; // get user input let s2 = Regex.Split(inp,operators);; // now build list of tokens let maketoken x = try Val(int(x)) // exception handling in F# with | excp -> match x with | y when (List.contains y keywords) -> Sym(y) | y when int(y.[0])>96 && int(y.[0])<123 -> Var(y) | y -> Sym(y);; let tokenize (s2:string[]) = let rec itokenize ax = function // inner tail-recursive function | i when i>=0 -> let t = s2.[i].Trim() if (t<>"") then itokenize (maketoken(s2.[i])::ax) (i-1) else itokenize ax (i-1) | _ -> ax; itokenize [EOF] (s2.Length-1);; let TS = tokenize s2;; printfn "token stream: %A" TS;; let mutable TI = 0;; // global index for TS stream;; /////////////////// /////////////////// ////////////////////////// SHIFT-REDUCE PARSER //////////////////////// let precedence = function | Val(_) -> 100 | Var(_) -> 100 | Sym(s) when prectable.ContainsKey(s) -> prectable.[s] | EOF -> 10 | _ -> 11;; let mutable assoc = fun sym -> match sym with | _ -> true; // true if left associative, false if right associative // Not all operators are left-associative: the assignment operator is // right associative: a = b = c; means first assign c to b, then b to a, // as is the F# type operator ->: a->b->c means a->(b->c). // check for precedence, associativity, and proper expressions to determine // if a reduce rule is applicable. let checkreducible(a,b,e1,e2) = let (pa,pb) = (precedence(a),precedence(b)) ((a=b && assoc(a)) || pa>=pb) && proper(e1) && proper(e2);; // parse takes parse stack and lookahead; default is shift // unify reduction of all binary operator expressions: let mutable binops = ["+";"-";"*";"/"];; // list of all binary operators // make parse into mutable function so we can add functionality later... let mutable parse = fun (x:expr list,expr) -> EOF // dummy for recursion parse <- fun (stack,lookahead) -> match (stack,lookahead) with | (Sym(")")::e1::Sym("(")::t, la) when checkreducible(Sym("("),la,e1,e1) -> parse (e1::t,la) | (e2::Sym(op)::e1::cdr,la) when (List.exists (fun x->x=op) binops) && checkreducible(Sym(op),la,e1,e2) -> let e = Binop(op,e1,e2) parse(e::cdr,la) | (e1::Sym("-")::t, la) when checkreducible(Sym("-"),la,e1,e1) -> // "rrc" let e = Uniop("-",e1) parse (e::t,la) | (e2::Sym(":")::e1::Sym("=")::Var(x)::t,la) when checkreducible(Sym("="),la,e1,e2) -> let e = Ternop("let",Var(x),e1,e2) //LET expressions parse(e::t,la) | ([e],EOF) when proper(e) -> e // base case, returns an expression | (st,la) when (TI < TS.Length-1) -> //shift TI <- TI+1; // shift means move lookahead symbol to stack let newla = TS.[TI] // new lookahead parse (la::st,newla) | (st,la) -> raise (Exception("parsing error: "+string(la::st)));; ///////////////////////////////// //////////////////////////////////////////////////////// ////// AOP-style "advice" to trace parse, eval. Dynamically change functions let advice_trace (target:unit->unit) = let proceed_parse = parse // simulate dynamic scoping let proceed_eval = eval let mutable cx = 1; // counter to prevent recursive advice on eval: parse <- fun(st,la) -> Console.WriteLine("parsing "+string(st)+" with lookahead "+string(la)) proceed_parse(st,la) eval <- fun env e -> if (cx>0) then Console.Write("evaluating "+string(e)); cx <- 0 // do not trace again proceed_eval env e target() // execute target eval <- proceed_eval parse <- proceed_parse;; // restore originals before exit ////// Advice to handle exceptions gracefully let advice_errhandle (target:unit->unit) = let proceed_parse = parse let proceed_eval = eval parse <- fun(st,la) -> try proceed_parse(st,la) with | exc -> Console.WriteLine("parse failed with exception "+string(exc)) exit(1) eval <- fun env e -> try (proceed_eval env e) with | exc -> Console.Write("eval failed with exception "+string(exc)) Console.WriteLine(", returning 0 as default...") 0 target() // execute target eval <- proceed_eval parse <- proceed_parse;; // restore originals before exit //// Each of the above advice applies to more than one function (parse, eval). // They can be said to "crosscut" multiple functions. The advice is // organized around the *aspect* of the program we're working on: tracing, // error handling, etc, as opposed to the algorithmic function. let run() = let ee = parse([],TS.[0]) let mutable Bindings = Dictionary() // why mutable? // insert bindings // Bindings.["x"] <- 2 let v = eval Bindings ee printf "\nValue of %s = %d\n" inp v;; //////// RUN UNDER ADVICE: // outermost advice will have precedence: advice_errhandle( fun () -> advice_trace( run ) );; //run();; // run without advice