(*  Description and Base Program for F# Assignment 3, Version 7E4

For this assignment, you will expand on the "online calculator" that I
provided in the code below to an interpreter for a programming language
"Hofstra Script".  The second part of this assignment will also ask you
to at least compile some fragment of this language into AM7B assembly,
which you've emulated in the last assignment.  You will again be provided
the .dll for this base program and you may only extend it modularly with
the same requirements on inheriting without copying or editing any existing
code.

    The base program contains the following major components:

    1. The definition of the abstract syntax representation of
       expressions such as 3+2*5, and (let x=2:x+x), etc.  These are
       variants of the expression trees that we have been studying.
       The type 'expr' is the type of expressions, and many cases have
       been included.  This is NOT a part of the program you will have
       to expand upon.  But you'll have to study it.

    2. The evaluation of abstract syntax expr's, corresponding to an
       interpreter.  The mutable function 'eval' evals all exprs to
       some int. The only type in this language is 32-bit signed int.
       However, since variables are also expressions,
       their evaluation requires an "environment".  The type 'environ'
       uses a F# list to represent bindings between variables and
       their values: type 'environ' is just an alias for type
       '(string*(expr ref)) list'.  That is, if this list is
       (x,xv)::cdr, then x is a string and xv is a reference to an
       expression. Unless you implement lambdas, however, the
       expression should only be of the form Val(n). xv is a reference
       so its contents can be changed when you implement the 'assign'
       operation.  The functions lookup/lookupval and change/changeval
       have been defined so you can use this data structure easily.

       The base function implemented here can only handle simple
       arithmetic expressions plus "cin" and "cout".

       The mutable 'eval' function is one of the main functions you will
       have to mutate to handle more cases.
       

    3. A Lexical analyser that takes an input string such as
      "7+3*2" and convert to a list of symbols (also of type expr) like
      [|Val(7.0);Sym("+");Val(3.0);Sym("*");Val(2.0);EOF|];  This
      token array is stored in the global variable TS and indexed by TI.
      This stage of compiling/interpreting is the least interesting and
      I've written all the code you should ever need.

      Note: the lexical analyzer is not capable of distinguishing
      between "=" and "==" as separate tokens.  I didn't spend too 
      much time on this part of the program and I used "eq" for
      boolean equality, "lt" for <,  "leq" for <=, etc.

      This part of the program is not one that you will have to change,
      and you shouldn't have to study its details either.
      
    4. An operator-precedence, shift-reduce parser that takes a list
       of tokens and returns an expr expression tree. I've already
       written all you will need here. However, you need to look at
       this code so you can see the forms of the abstract syntax
       representations of expressions, especially for let-bindings
       and lambda terms.  The shift-reduce parser is also excellent
       example of declarative programming in F# using pattern matching
       on lists.

    5. A compiler that takes an expr tree and compiles code for it
       into am7b+ assembly.  The 'compile7b' function takes three
       arguments: (st,exp,ln) where st is an environ, but which is
       here used as a "symbol table".  This table associates where in
       memory each variable is stored at as well as the starting
       instruction number of each lambda function.  exp is the expr
       tree to be compiled.  ln is the instruction number for the
       first instruction to be generated.  This function should return
       a value of the form (s,lx), where s is a string (with \n to
       break lines) representing the instructions generated and lx is
       the next instruction number.  You must keep track of the
       instruction numbers carefully when generating jmp (and jz, jnz,
       jn, call) instructions.  The ln and st arguments are not used
       in the base compiler, but will be needed when you compile more
       advanced expressions.

       The base compile function here can only compile basic arithmetic
       expressions (as found in the online calculator)

    6. Various AOP-style "advice" intended to locally add features to
       existing code.


                   =======  THE ASSIGNMENT =======

    **************Levels 1-3 are due Tuesday 11/26.****************

This assignment will ask you to extend, modularly as always, this base
program to have more capabilities.  This assignment will be graded by
your demonstrations.  Your work will be graded on the following scale:

Level 1: to obtain a minimally acceptable grade (as in barely passable)
    you must be able to interpret (evalutate) boolean expressions and
    if-else expressions.  Since the language here only has integer
    as type, we will use 0 for false, and anything non-zero for true.
    You need to be able to evaluate expressions such as (3 eq 1+2),
    and (2 lt 4-1).  Here, eq and lt are "equals" and "less than"
    respectively.  Once you've implemented these booleans, you need to
    interpret if-else expressions such as if (3 lt 2) 3 else 4, which
    should evaluate to 4, and if (0 eq 1-1) 10 else 20, which should
    evaluate to 10.  Your if expression must be implemented to any
    boolean expression generically, not just these two examples (in
    the future, we may need to add &, |, etc).  You must be able to
    handle nested if's, which should work naturally if you implemented
    your program without making special assumptions.  In abstract syntax,
    if expressions are represented by Ternop("if",e1,e2,e3) where e1
    is the boolean expression (evaluates to 0 for false, non-zero for true)
    and e2,e3 are the alternatives.

    After level 1, you can continue to either level 2 or level 2.5.

Level 2: To obtain a somewhat better grade, you must complete Level 1
    and be able to handle let expressions that binds integer variables
    (let x=3:...). The scope of let must be respected: let x=3:x+(let
    x=4:x+x)+x should evaluate to 14.  To do this, you need to
    add a new binding for the variable in the enviornment structure using
    the 'pushed' function (find below):

    let pushed x e env = (x,ref e)::env; // to add ref binding to environment

    This function is non-destructive: it does not change env but
    returns a new structure with a binding of x to e in front.  Being
    non-destructive is important because it will not affect how
    expressions are evaluated outside of the current "scope".  The
    binding e is in the form (ref Val(int)) for integer bindings.  Use
    the 'lookupval' function to look up an integer value bound to a
    string in the env.  The parser returns abstract syntax for
    let-expressions in the form Letexp(x,e1,e2).

    Note that the lexical analyzer returns exprs like Var("x") for variables
    and Sym("if") for keywords.

    To complete level 2, you must also be able to evaluate assignment
    operations, sequence statments and while loops.  The value of an
    assignment statement (Assign(string,expr)) is the value of the
    expression the variable is assigned to (which is not necessarilty
    a Val: it could be x=x+1)  The value of a sequence of expressions
    (Seq(expr list)) is the value of the last expression in the list.
    The value of a while loop is the value of the last expression evaluated
    by the loop.  You must show that you are capable of running level-2
    sample .hs programs.
    

Level 2.5: To obtain this level of grade, you must first complete
    Level 1 then extend the compiler to also compile the expressions
    interpreted at level 1: booleans and if-else expressions.  Your
    compiled code should run on am7b.  You will have to extend the
    definition of the 'compile7b' function.

    To compile an expr tree, execute a post-order traversal: this 
    will implement call-by-value.  At every node of the tree, code 
    should be generated to push the value of that subtree onto the stack.
    **Do not deviate from the stack protocol. The result of compiling any 
    expr must be pushing the result onto the stack.  It becomes immensely 
    more complicated if you don't follow this protocol.  
    You will end up generating a lot of code that looks like:
        push 3
        pop ax
    Do NOT be tempted to generate mov 3 ax instead, because that will
    break the protocol and make your life miserable.  You can optimize
    code like this after the entire program's been generated.

    Level 2.5 is slightly harder than level 2. If you do
    both levels 2a and 2b you will be at level 2.75.

Level 3: For this level, you must first complete level 2, then extend
    the interpreter to handle lambda bindings.  To properly implement
    static scoping, each lambda term must be placed in a CLOSURE that
    contains the environment under which it was defined.  You must
    also be able to handle recursive lambdas ( just add a binding for
    the lambda to its own closure).  The parser recognizes and
    returns expressions of the forms Lambda(x,e) and App(f,e).  Since
    lambdas could only appear in a let-binding, 'f' is just a string
    (there are no inlined lambdas, and there also can't be
     lambda x.lambda y..).

    Examples to try:
    let f=(lambda x.x+x):let g=(lambda x.x*x):(f (f (g 3)))  //evals to 36
    let log=(lambda n.(if (n lt 2) 0 else 1+(log (n/2)))):(log 256) //evals to 8

    Your interpreter for this level must pass the "area 51" test:

       let pi = 314159: 
       let area = (lambda r.(pi*r*r)/100000):
       let pi = 0: (area 51)

    Save your planet.  

Level 4: Complete both level 3 and level 2.5.  This will earn
    full marks for this assignment.

Level 5: For this level, you must first complete Level 4.  You then
    need to be able to compile the expressions (let-binding for
    intergers, assignments and while loops) that were interpreted at
    level 2.  To compile let-bindings, the enviornment data structure
    that's passed to the compile function needs to record a fixed
    memory location that you've assigned to each variable.  That is,
    if ("x",ref Val(2000)) is in the environment, then the value of
    Var("x") is contained in RAM.[2000] in AM7B.  This level forces
    you to think carefully about the difference between compile time
    and runtime (it will teach you a lot).  You will have to use RAM
    as both a stack and heap.  As a suggestion, reserve the higher end
    of memory to represent the heap (say the last 512 words).  You MAY
    change your own code for the past assignment so that the stack
    does not grow past RAM.Length-512.  Use a "heap pointer variable"
    to keep track of the next available slot on the heap, but keep in
    mind that sp is always 0 at compile time.

Level 6: This is the ultimate level and to both save your planet and
    come to mine you must first complete ALL previous levels.  Then
    you must be able to compile lambda terms and function calls:
    compile what was interpreted at level 3.  This level will
    genuinely teach you about the difficulties of writing a compiler
    and how to implement high-level abstraction on a low-level
    machine.  For this level, you will finally make use of the 'bp'
    register (rbp in x64 architecure).  This allows us to create a
    "stack frame" for each function call, and to restore the stack
    when a function returns.  I recommend that you implement the
    functional calling protocol similar to that used by C and
    inherited by many languages:

// To call a procedure, the calling procedure will:
//   1.push the argument to the call on the stack - in our case there is
//     always only one argument
//   2. executes CALL (am7b) instruction
//   3. when function returns, the return value will be on top of the stack, 
//   in the position previously occupied by the argument.

// The called procedure does the following
//   push bp
//   mov sp bp
//   .... body of procedure, code must leave return value on stack
//   pop ax  # pops return value off of stack
//   mov bp bx   
//   add 3 bx  - this calculates address of argument: [bp-3]
//   mov ax [bx]  - copies return value into place.
//   mov bp sp  # restore previous sp
//   pop bp      # restores previous bp
//   ret         # pops into pc and jump to return address


    ***************************
    The following is the base program, which can interpret and compile
    basic arithmetic expressions such as 3+2*4, and correspond to the
    basic am7b (before it was extended to have more instructions).

    To compile:
    fsc/fsharpc hsbase.fs -r am7b19.dll 
    To run:
    mono hsbase.exe interpret < program.hs
    mono hsbase.exe compile   < program.hs
    mono hsbase.exe  (prompts user for one-line expressions and evaluates it)

    hsbase.dll, which you will need, will not call runit() at the end,
    so you should add it to the end of your program.
*)
// your file should also start like this:
module CSC7B
open System;
open Microsoft.FSharp.Math;
open System.Text.RegularExpressions;
open System.Collections.Generic;
open CSC7B;;

//// COMPONENT 1:
////////////////////  Abstract Syntax (not all cases used in this program) ///

// environ and expr must be defined together because a Closure contains
// an environ

type environ = (string*expr ref) list
     and 
     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) | Letexp of string*expr*expr | Closure of (environ*expr) | App of string*expr | Lambda of string*expr | Assign of string*expr | Print of expr | Sym of string | EOF ;;

let rec lookup x (env:environ) =  // returns expr
   match env with
    | [] -> raise(Exception(x+" not found in environment/table"))
    | ((y,rv)::cdr) when x=y -> !rv
    | ((y,rv)::cdr) -> lookup x cdr
let lookupval x env =    // returns int, use when looking for simple bindings
   let v = lookup x env
   match v with
     | Val(n) -> n
     | _ -> raise(Exception(string(v)+" is not an int"));;
let rec change x n (env:environ) =   
   match env with
    | [] -> raise(Exception(x+" not declared in this scope"))
    | ((y,rv)::cdr) when x=y -> rv := n
    | ((y,rv)::cdr) -> change x n cdr;;
let changeval x n env = change x (Val(n)) env;;   // n is int (use for Assign)
// note: change and changeval are destructive operations

let pushed x e env = (x,ref e)::env; // to add ref binding to environment
// pushed is a NON_DESTRUCTIVE operation: env is enchanged (pushed x e env)
// is a new environment: this is important for implementing scope, so we
// do not want the existing enviornment to be changed permanently.

let rec bindingexistsfor x (env:environ) =
   match env with
    | [] -> false
    | ((y,rv)::cdr) when x=y -> true
    | ((y,rv)::cdr) -> bindingexistsfor x cdr;;
  
//// Note: because it's difficult to extend a discriminated union modularly,
// we are using strings to represent different kinds of expressions, so there
// is a cost to be paid in terms of static type safety.  Although pure F# is
// statically "type safe", there is not much type information available when
// use strings to represent data.  


//// COMPONENT 2: evaluation/interpretation
// use environments of the form [("x",ref Val(0));("y",ref Val(0))] ...

// Because of variable expressions, env represents bindings for variables.
// eval is mutable so we can inject behaviors later...
// mutable funs can't be recursive calls, unless we declare bind them
// to a "dummy" function of the right type:
let mutable eval = fun (env:environ) (exp:expr) -> 0;;
eval <- fun (env:environ) exp ->
  match exp with
    | Val(v) -> v
    | Var(x) -> lookupval x env  // this lookup assumes that x is bound to int
    | Binop("+",a,b) -> (eval env a) + (eval env b)  // not Plus(a,b), so
    | 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)
    | Uniop("-",a) -> -1 * (eval env a)
    | Uniop("cin",_) ->    // look, it's C++!
        writenoln("<< ")
        let sinp = getln() 
        try (int(sinp))
          with
          | _ -> raise(Exception("input is not an integer"))
    | Uniop("cout",Sym(s)) ->
        let s2=s.Replace("\\n","\n")
        writenoln(s2)
        0  // void ops should always return 0
    | Uniop("cout",e1) ->
        let ev1 = eval env e1
        writenoln(string(ev1))
        0
    | x -> raise (Exception("not supported eval case: "+string(x)));;
////////////////////////////////////////////////////
// To get started, the above cases do not evaluate the  % operator, so
// the first clause should add should address that:
// eval <- fun env exp ->  // after saving the original eval to another var
//   match exp with
//    | Binop("%",a,b) -> ...



//// COMPONENT 3:
//////////////////       LEXICAL ANALYSER (LEXER)  // (ignore most here)

///////////////// Lexical Symbol Specification

// use regular expression to represent possible operator symbols:
let mutable operators = "([()\+\-\*/:;%^,.]|\s|\[|\]|=)";
let mutable keywords = ["if";"then";"else";"while";"let";"eq";"leq";"lt";"print";"begin";"end";"lambda";"def";"cin";"cout"];
let mutable curops = operators.[0..operators.Length-2];
//operators <- curops + "|" + "\".*\"" + ")";
operators <- curops + "|" + "\"[^\"]*\"" + ")";

// Reads expressions like  "7+3*2" and convert to list of symbols like
// [|Val(7.0);Sym("+");Val(3.0);Sym("*");Val(2.0);EOF|];
//// This is the first stage of parsing, called lexical analysis or token
// analysis

// assume string is in input_string

// 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 when y.[0]='\"' -> Sym(y.[1..y.Length-2])
                       | 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 mutable TS =[];; // global list of tokens
let mutable TI = 0;; // global index for TS stream;;

let mutable input_string = "";; // default input string, GLOBAL!

///// The following function takes an input string and sets global
// variable TS, which is a stream of tokens (see commented example above
// for (7+3*2)).  It also sets TI, which is a global index into TS.
let mutable lexer = fun (inp:string) ->  // main lexical analysis function
  let s2 = Regex.Split(inp,operators)
  TS <- tokenize s2
  TI <- 0  // reset if needed
//  printfn "token stream: %A" TS;;


////// COMPONENT 4
////////////////////////// SHIFT-REDUCE PARSER ////////////////////////
(*  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
	 if E E else E  |
	 let string=lambda string.E:E |
	 let string = E:E  |  ...
*)

let mutable binops = ["+";"*";"/";"-";"%";"^";"eq";"lt";"leq";"while";"assign"];
let mutable unaryops = ["-"; "!"; "~";"cin";"cout"];
let mutable ternaryops = ["if"];;

// use hash table (Dictionary) to associate each operator with precedence
let prectable = Dictionary<string,int>();;
prectable.["+"] <- 200;
prectable.["-"] <- 300;
prectable.["*"] <- 400;
prectable.["/"] <- 500;
prectable.["("] <- 990;
prectable.[")"] <- 20;
prectable.[":"] <- 42;   // trial by error... got to be careful
prectable.["="] <- 30;
prectable.["."] <- 20;
prectable.["_"] <- 600;
prectable.["eq"] <- 35;
prectable.["leq"] <- 35;
prectable.["lt"] <- 35;
prectable.["if"] <- 20;
prectable.["let"] <- 42;
prectable.["while"] <- 40
prectable.["else"] <- 18; //20
prectable.["cin"] <- 100 //  same as Val
prectable.["cout"] <- 22;
prectable.[";"] <- 20;
prectable.["begin"] <- 20;
prectable.["end"] <- 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
// Also change binops, unaryops, if neccessary:
unaryops <- "print"::unaryops;;  // add print(expr) as a unary operation

/// Lexical Token stream and abstract syntax combined into expr, the
//  following will try to distinguish them.
// Proper expression check (shallow): separates proper expression from tokens
// This is the price to pay for using strings: no compile-time verification
let mutable proper = fun f ->
  match f with
    | Binop(s,_,_) when (List.exists (fun x->x=s) binops)  -> true
    | Uniop(s,_) when (List.exists (fun x->x=s) unaryops) -> true
    | Ternop("let",Var(x),_,_) -> true
    | Ternop(s,_,_,_) when (List.exists (fun x->x=s) ternaryops) -> true
    | Seq(_) -> true
    | Binop(_,_,_) -> false;
    | Uniop(_,_) -> false;
    | Sym("cin") -> true
    | Sym(_) -> false
    | EOF -> false
    | _ -> true;;


// function defines precedence of symbol, which includes more than just Syms
let mutable precedence = fun s ->
  match s with
   | Val(_) -> 100
   | Var(_) -> 100
   | Sym(s) when prectable.ContainsKey(s) -> prectable.[s]
   | EOF    -> 10
   | _ -> 11;;
   
// Function defines associativity: true if left associative, false if right...
// 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).

let mutable leftassoc = fun e ->
  match e with
   | _ -> true;  // most operators are left associative.


// check for precedence, associativity, and proper expressions to determine
// if a reduce rule is applicable.
let mutable checkreducible = fun (a,b,e1,e2) ->
  let (pa,pb) = (precedence(a),precedence(b))
  ((a=b && leftassoc(a)) || pa>=pb) && proper(e1) && proper(e2);;

// parse takes parse stack and lookahead; default is shift

////////////////// HERE IS THE HEART OF THE SHIFT-REDUCE PARSER ////////
let mutable parse = fun (x:expr list,expr) -> EOF // dummy for recursion
parse <- fun (stack,lookahead) ->
  match (stack,lookahead) with
   | ([e],EOF) when proper(e) -> e   // base case, returns an expression
   | (Sym(")")::e1::Var(f)::Sym("(")::t,la) when int(f.[0])>96 && int(f.[0])<123 && checkreducible(Sym("_"),la,e1,e1) ->
        let e = App(f,e1)
        parse(e::t,la)
   | (Sym(")")::e1::Sym("(")::t, la) when checkreducible(Sym("("),la,e1,e1) ->
        parse (e1::t,la)
   | (Sym("cin")::t,la) when (precedence (Sym "cin"))>=(precedence la) ->
        let e= Uniop("cin",Val(0))       // Val(0) is just filler
        parse(e::t,la)
   | (e2::Sym("cout")::t,la) when checkreducible(Sym("cout"),la,e2,e2) ->
        let e = Uniop("cout",e2)
        parse(e::t,la)
   | (Sym(s)::Sym("cout")::t,la) when checkreducible(Sym("cout"),la,Var(s),Var(s)) ->
        let e = Uniop("cout",Sym(s))
        parse(e::t,la)
   | (e2::Sym(op)::e1::cdr,la)   // generic case for binary operators
     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)::Sym("let")::t,la) when checkreducible(Sym(":"),la,e1,e2) -> 
        let e = Letexp(x,e1,e2) //Ternop("let",Var(x),e1,e2)  //let expressions
        parse(e::t,la)
   | (e1::Sym("=")::Var(x)::t,la) when checkreducible(Sym("="),la,e1,e1) ->
        let e = Assign(x,e1)
        parse(e::t,la)
   | (e1::Sym(".")::Var(x)::Sym("lambda")::t,la) when checkreducible(Sym("."),la,e1,e1) ->
        let e = Lambda(x,e1)
        parse(e::t,la)
   | (e3::Sym("else")::e2::e1::Sym("if")::t,la) when checkreducible(Sym("if"),la,e1,e2) && proper(e3) -> 
        let e = Ternop("if",e1,e2,e3)
        parse (e::t,la)
   | (body::be::Sym("while")::t,la) when checkreducible(Sym("while"),la,be,be) ->
        let e = Binop("while",be,body) in parse(e::t,la)   
   | (Sym(";")::e1::t,la) when checkreducible(Sym("end"),la,e1,e1) ->
        let e = Seq([e1]) in parse(e::t,la)
   | (Seq(s2)::Sym(";")::e1::t,la) when checkreducible(Sym("end"),la,e1,e1) ->
        let e = Seq(e1::s2) in parse(e::t,la)
   | (st,la) when (TI < TS.Length-1) ->  // shift case
        TI <- TI+1;         
        let newla = TS.[TI]
        parse (la::st,newla)
   | (st,la) ->
        let mutable ms = "parsing error: "
        for x in (la::st) do ms <- ms+string(x)+"::"
        raise (Exception(ms));; //"parsing error: "+string(la::st)));;
/////////////////////////////////


//// COMPONENT 5
///////////////////////////// BASE COMPILER /////////////////////
//// limited compiler:
let transinst = function    // translate single instruction
  | "+" -> "add"
  | "-" -> "sub"
  | "*" -> "imul"
  | "/" -> "idiv"
  | x -> x

let mutable hp = RAM.Length-1;   // heap pointer register (decreases)
//let mutable HEAPMAX = RAM.Length-256;

// compile7b must compile expression and take next line number,
// returns next line number, initial line number should be 0
let mutable compile7b = fun (st:environ,exp:expr,line:int) -> ("",0) // dummy
// must return large string
let addi(s:string,inst) = s+inst+"\n"; // for readability

//compiler take as arguments: symbol table (environ), expression, next line num.
compile7b <- fun (st:environ,exp,ln) ->
  match exp with
    | Val(x) -> (sprintf "push %d\n" x),ln+1 //=("push "+string(x)+"\n",ln+1
    | Binop(op,a,b) when (transinst op)<>op ->
        let opr = transinst op
        let (aa,ln2) = compile7b(st,a,ln)
        let (bs,ln3) = compile7b(st,b,ln2)
        let mutable ops = aa+bs+ "pop bx\n" 
        ops <- ops + "pop ax\n"
        ops <- ops + opr+" bx ax\n"
        ops <- ops+"push ax\n"
        (ops,ln3+4)
    | Uniop("-",e) ->
        let (es,lne) = compile7b(st,e,ln)
        let mutable s = addi(es,"mov -1 bx")
        s <- addi(s,"pop ax")
        s <- addi(s,"imul bx ax")
        s <- addi(s,"push ax")
        (s,lne+4)
    | x -> (sprintf "# compilation of %A not supported at this time\n" x),ln;;
//compile7b returns (instructions-string,next-line-number)

//// To get started, the generic clause for Binop above cannot handle the
// the % operator because of the way it's implemented specifically in am7b,
// So in your function, first add a clause for %.


//// COMPONENT 6: AOP Advice
////////////////////////

// advice to trace before/after parse, eval and compile: this advice
// does not use writeln for output: output is always to stdout.
let mutable traceopt = fun (before,after,target:unit->unit) ->
  let proceed_compile = compile7b   // simulate dynamic scoping
  let proceed_eval = eval
  let proceed_parse = parse
  eval <- fun env e ->
     if before then printfn "evaluating %A under env %A" e env
     let v = proceed_eval env e
     if after then printfn "  eval returned %d" v
     v  // return
  compile7b <- fun (st,e,ln) ->
     if before then printfn "compiling %A under symtab %A at line %d" e st ln
     let (s,lnn) = proceed_compile(st,e,ln) 
     if after then printfn "  compiler returned %A" (s,lnn)
     (s,lnn)
  parse <- fun(st,la) ->
     if before then printfn "parsing %A with lookahead %A" st la
     let e = proceed_parse(st,la)
     if after then printfn "  parse returned expression %A" e
     e //return
  target()  // execute target operation
  eval <- proceed_eval      
  parse <- proceed_parse
  compile7b <- proceed_compile;; // restore originals before exit  


////// Advice to handle exceptions gracefully
let mutable advice_errhandle = fun (target:unit->unit) ->
  let proceed_parse = parse
  let proceed_eval = eval
  parse <- fun(st,la) ->
     try proceed_parse(st,la) with
       | exc ->
           writeln("parse failed with exception "+string(exc))
           exit(1)
  eval <- fun env e ->
     try (proceed_eval env e) with
       | exc ->
           writeln("eval failed with exception "+string(exc)+", returning 0 by default")
           0
  target()  // execute target
  eval <- proceed_eval      
  parse <- proceed_parse;; // restore originals before exit
// advice_errhandle

/// Note that these advice functions group together code that "crosscut" 
// the conventional function-oriented design to be oriented instead towards
// certain "aspects" of the program (tracing, error handling).

///// Advice to read from stdin with prompt:
let mutable advice_io = fun (prompt, target:unit->unit) ->
    if prompt then 
       writenoln("Enter expression: ");
       input_string <- getln()
    else  // take multi-line input
       let mutable inp = "x"
       while inp<>null do
         inp <- getln()
         if inp<>null && inp.Length>0 && inp.[0]<>'#' then 
            input_string <- input_string + inp + " "
    lexer(input_string)
    target();;
//advice_io doesn't need to modify any functions, just inject before target

//// main execution function
let mutable run = fun () ->
  let ee = parse([],TS.[0])
  //  let mutable Bindings = Base(Dictionary<string,int>())
  //printfn "parse tree: %A" ee  //////////////// TRACE
  let mutable Bindings:environ = []
  let v = eval Bindings ee
  let ps=(sprintf "\nValue of %s = %d\n" input_string v) in writeln(ps)
let mutable interpret = run;

//////// RUN UNDER ADVICE, innermost advice will have precedence:
//advice_io(true, fun ()-> advice_errhandle( fun () -> advice_trace( run ) ));; 

//lexer(Console.ReadLine()); // tokenize without prompt
// run();; // runs without any advice, must call lexer on some input string.


// default:  (commented out when generating .dll)
//advice_io(true,run);; // run with just input advice and console prompt option

//success:  (let f=lambda x.x+x:(f 5))
// Value of (let x=3:(let f=lambda y.x+y:(let x=5:(f 1)))) = 4  // yeah!
// Value of (let f=lambda x.x+x:(let g=lambda x.x*x:(f (g 3)))) = 18

let mutable compile = fun () ->
   let exp = parse([],TS.[0])
   let prog,ln = compile7b([],exp,0)
   writeln(prog+"nop");  
   writeln("# compiled for: "+input_string);;

//////
//// main execution function
let runit() = 
  let argv = Environment.GetCommandLineArgs();
  if argv.Length>1 && argv.[1] = "compile" then
     if argv.Length>2 && argv.[2] = "prompt" then
       advice_io(true,compile)
     else
       advice_io(false,compile); // advice to compile  (send output to stdout)
  else if argv.Length>1 && argv.[1] = "interpret" then
         //traceopt(false,true,fun ()->advice_io(false,interpret))
         advice_io(false,interpret)
       else advice_io(true,interpret);;  // advice to interpret interactive

// run with before-trace option (trace call but not return):

//traceopt(true,true,runit);;
//runit();

//// .dll was compiled with above line commented out.
// please put both module CSC7B and open CSC7B at the top of your program
// like here.  If you want all definitions to be visible, then compile with
// multiple .dlls:  fsharpc program.fs -r first.dll -r second.dll ...
////////// run (mono) hsbase.exe compile/interpret