(* F# Assignment: Working with Expression Trees. Compile this skeleton with fsharpc exptreeasn.fs -r simpleLexer.dll Your task is to modify the following program but adding more operators to the language and to change the 'eval' function to return option instead of raising exceptions when errors occur. Errors that must be handled include divsion/mod by zero and arithmetic overflow from multiplication (optionally for addition and subtraction). *) open System open System.Collections.Generic; open Option ///////////////////////////////////////////////// //Abstract Syntax for expressions in Language "Lambda7b", version 7e7 type expr = | Num of int // integer constants | Var of string // alphanumeric identifiers like x, y1, etc | Strlit of string // string literals "abc", includes ""'s inside string | Uniop of string * expr // unary opertions such as Uniop "-" (Num 3) | Binop of string * expr * expr // e.g. Binop("*",A,B), Binop("+",A,B) | Ternop of string * expr * expr * expr // Ternary operation | Sequence of expr list // sequence of expressions | Sym of string // token "*": not an expression, exists pre-parsing only | EOF;; // EOF - pre-parsing only. let sample_expr = Binop("-",Num(5),Num(3)); // the AST for "5-3" let sample2 = Ternop("if",Num(0),Num(1),sample_expr); //if (0) 1 else (5-3); // evaluation of expr without variables, raises exceptions let rec eval = function // equiv to: let rec eval e = match e with ... | Num(n) -> n | Uniop("-",e) -> -1 * (eval e) | Binop("+",a,b) -> (eval a) + (eval b) | Binop("-",a,b) -> eval(a) + eval(b) | Binop("*",a,b) -> eval(a) * eval(b) | Binop("/",a,b) -> eval(a) / eval(b) | Binop("%",a,b) -> eval(a) % eval(b) | Ternop("if",condition,truecase,falsecase) -> if eval(condition)<>0 then eval(truecase) else eval(falsecase) | Binop("while",condition,body) -> let mutable result = 0; while eval(condition)<>0 do result <- eval(body) result | Sequence [] -> 0 | Sequence [a] -> eval a | Sequence (a::b) -> ignore (eval a); eval (Sequence b) | Sym("cin") -> let cin = Console.ReadLine(); let x = ref 0; Int32.TryParse(cin,x) |> ignore !x | Uniop("cout",Strlit(s)) -> printf "%s" s; 0 // cout always returns 0 | Uniop("cout",e) -> printf "%A" (eval e); 0 | e -> raise (Exception(sprintf "no rule to evaluate %A" e));; // notice if we returned 0 in the default case, this would behave like Perl! (* PART I: Modify the above program to include cases for the boolean operators "&&", "||", "!" and "==". Booleans in Lambda7b are treated as in C: 0 is false and anything non-zero is true. The eval function must still return an integer, so 1 && 0 should eval to 0 (false). *) (* PART II: Write a new version of the eval function that, instead of returning int, will return option, that is, Some(n) where n is an int, or None. For example, 1/0 should eval to None, so should 1%0, and 100000000*10000000 (overflow). You can always do this using match: for example match (eval a, eval b) with | (Some(n),Some(m)) when m<>0 -> Some(n/m) | _ -> eprintfn "DIV BY ZERO"; None However, for some of the cases it may be easier to apply the monadic combinators map or bind: eval(a) |> bind (fun n -> eval(b) |> map (fun m -> n+m)) or eval(a) |> bind (fun n -> eval(b) |> bind (fun m -> Some(n+m))) 'bind' maps a function int -> option over an option while 'map' maps a function int -> int over an option. There's also eval(a) |> iter (fun n -> printfn "%A" n); if the function being mapped does not return a value (returns type unit) These functions will not do anthing if the option is None. However, you should always print an error message (eprintf or Console.Error.Write) when an error occurs. *) ////////////////////////////////////// leave this part alone for now /////// ////////////// OPERATOR PRECEDENCE BOTTOM-UP PARSING let precedence = function | Sym("+") -> 100 | Sym("-") -> 100 | Sym("*") -> 200 | Sym("/") -> 200 | Sym("%") -> 200 | Sym("||") -> 400 | Sym("&&") -> 400 | Sym("==") -> 400 | Sym("!") -> 500 | Sym("(") -> 1000 | Sym(")") -> 20 | _ -> 20;; let binops = ["+";"-";"*";"/";"%";"||";"&&";"==";"while"]; let uniops = ["-";"!";"cout"]; let inlist(x,L) = List.exists (fun y -> y=x) L let proper_expr = function // identify pre-parsing symbols | EOF -> false | Sym("cin") -> true | Sym(_) -> false | _ -> true; let mutable leftassoc = fun x -> true;; // this assumes all ops are left-assoc // check for precedence and proper expressions let check(a,b,e1,e2) = match (a,b) with | (a,b) when a=b -> leftassoc(a) && proper_expr(e1) && proper_expr(e2) | (a,b) -> let (pa,pb) = (precedence(a),precedence(b)); (pa >= pb) && proper_expr(e1) && proper_expr(e2);; //check ///////// bottom-up, operator precedence parser: let rec parse (pstack,input:expr list) = match (pstack,input) with | ([ast], [EOF]) -> ast // ACCEPT | (Sym(")")::e1::Sym("(")::pst, la::inp) when check(Sym("("),la,e1,e1) -> parse (e1::pst, la::inp) | (fcase::Sym("else")::tcase::cond::Sym("if")::pst, la::inp) when check(Sym("if"),la,tcase,fcase) -> parse (Ternop("if",cond,tcase,fcase)::pst, la::inp) | (e2::Sym(s)::e1::pst, la::inp) when inlist(s,binops) && check(Sym(s),la,e1,e2) -> parse (Binop(s,e1,e2)::pst, la::inp) | (e::Sym(s)::pst, la::inp) when inlist(s,uniops) && check(Sym(s),la,e,e) -> parse (Uniop(s,e)::pst, la::inp) | (pst, la::inp) when la<>EOF -> parse (la::pst, inp) // shift | (p,i) -> Sym(sprintf "Error, parse stack %A" p);; /////// lexical tokenizer // function to convert C# lexToken structures to F# type expr let convert_token (token:lexToken) = match token.token_type with | "Integer" -> Num(token.token_value :?> int) // :?> downcasts from obj | "Alphanumeric" -> Var(token.token_value :?> string) | "Symbol" | "Keyword" -> Sym(token.token_value :?> string) | "StringLiteral" -> Strlit(token.token_value :?> string) | _ -> EOF;; // if can't tokenize, force end of stream // reverses list m while applying function f to each value let rec revmap f M stack = match (M,stack) with | ([],s) -> s | (a::b,s) -> revmap f b ((f a)::s);; let rec gettokens (lexer:simpleLexer) ax = let next_token = lexer.next() if next_token=null then ax else gettokens lexer (next_token::ax);; // collect all tokens into a list, which will enable pattern matching let tokenize(lexer:simpleLexer) = let tokens = gettokens lexer [] revmap convert_token tokens [EOF];; ///////////////// main function let main() = Console.Write("Enter expression: "); let inp = Console.ReadLine(); // get user raw input let lexer = simpleLexer(inp); // create lexical tokenizer lexer.addKeyword("cout"); lexer.addKeyword("cin"); let input_tokens = tokenize lexer let ast = parse([],input_tokens) let result = eval ast printfn "Final result = %A" result;; // run main main();