exception Exn of string;

datatype Op = Add | Sub | Mul | Div | Assign | Equals;
datatype Token = Num of int | Identifier of string | StringLiteral of string | Semi | RCurly | LCurly | LParen | RParen | Comma | OpToken of Op | If | Then | Else | Fn;

datatype Expr = Constant of Value | Variable of string | BinaryExpr of Expr*Op*Expr | AssignExpr of string*Expr | 
                LambdaExpr of string list * Expr | CallExpr of Expr * Expr list | IfExpr of Expr*Expr*Expr | SequenceExpr of Expr list
     and Value = StringValue of string | IntValue of int | LambdaValue of string list*Expr*Scope | NullValue | NativeLambdaValue of (Value list -> Value)
     and Scope = ScopeVal of string*Value*Scope | ScopeChain of Scope | ScopeTop;

(* helper stuff *)
fun foldleft f (e,[]) = e | foldleft f (e,x::xs) = foldleft f (f(e,x), xs);
fun isDigit c = c>= #"0" andalso c<= #"9";
fun isAlpha c = c>= #"A" andalso c<= #"Z" orelse c>= #"a" andalso c<= #"z";
fun isAlphaNum c = isAlpha c orelse isDigit c;
fun isSpace c = c= #" " orelse c= #"\n";
fun charToInt c = ord(c)-ord(#"0");

fun toString(IntValue(i)) = Int.toString(i)
  | toString(NullValue) = "*NULL*"
  | toString(LambdaValue(_,_,_)) = "*Function*"
  | toString(NativeLambdaValue(_)) = "*Native Function*"
  | toString(StringValue(s)) = s;

fun toInt(IntValue(i)) = i
  | toInt(StringValue(s)) = (case Int.fromString(s) of SOME(i) => i | NONE => 0)
  | toInt NullValue = 0
  | toInt _ = 1;


fun printValue v = TextIO.print(toString(v)^"\n");

fun printScope (ScopeVal(k,v,s)) = (TextIO.print(k ^ " = " ^ toString(v) ^ "\n"); printScope(s))
  | printScope (ScopeChain(s)) = printScope s
  | printScope ScopeTop = TextIO.print("--> ScopeTop <--\n");

fun opDesc Add = "Add" | opDesc Sub = "Sub" | opDesc  Mul = "Mul" | opDesc Div = "Div" | opDesc Assign = "Assign" | opDesc Equals = "Equals";
fun tokDesc (Num(i)) = "Integer: " ^ Int.toString(i)
  | tokDesc (Identifier(s)) = "Identifier: " ^ s
  | tokDesc Semi = "Semi"
  | tokDesc RCurly = "RCurly"
  | tokDesc LCurly = "LCurly"
  | tokDesc LParen = "LParen"
  | tokDesc RParen = "RParen"
  | tokDesc Comma = "Comma"
  | tokDesc If = "if"
  | tokDesc Else = "else"
  | tokDesc Then = "then"
  | tokDesc Fn = "fn"
  | tokDesc (OpToken(x)) = "OpToken: " ^ opDesc(x);

fun prec Add = 3
  | prec Sub = 3
  | prec Mul = 4
  | prec Div = 4
  | prec Equals = 2
  | prec Assign = 1;

fun lex s = let 
    fun readInt(n,[]) = (n,nil)
      | readInt(n,c::cs) = 
          if isDigit(c) then readInt(n*10+charToInt(c),cs)
          else (n,c::cs);

    fun readIdentifier(l,[]) = (rev l,nil)
      | readIdentifier(l,c::cs) = if isAlphaNum(c) then readIdentifier(c::l,cs) else (rev l,c::cs);
          
    fun readStringLiteral(l,[]) = (rev l, nil)
      | readStringLiteral(l,c::cs) = if c = #"\"" then (rev l,cs) else readStringLiteral(c::l,cs)
                  
    fun readSymbol(c,rest) =
        case c of #"+" => (OpToken Add,rest)
                | #"-" => (OpToken Sub,rest)
                | #"*" => (OpToken Mul,rest)
                | #"/" => (OpToken Div,rest)
                | #"=" => (case rest of (#"="::rest2) => (OpToken Equals,rest2) | _ => (OpToken Assign,rest))
                | #";" => (Semi,rest)
                | #"}" => (RCurly,rest)
                | #"{" => (LCurly,rest)
                | #"(" => (LParen,rest)
                | #")" => (RParen,rest)
                | #"," => (Comma,rest)
                | _ => raise Exn("Invalid Symbol");
       
    fun helper(tokens, []) =  tokens
      | helper(tokens, c::cs) = 
        if isSpace c then
            helper(tokens,cs)
        else if isDigit c then
           let val (n,cs2) = readInt(0,c::cs)
           in helper(Num n::tokens,cs2) end
        else if isAlpha c then
            let
                val (l,cs2) = readIdentifier([],c::cs)
                val s = (implode l)
            in helper(
                (case s of
                    "if" => If | "else" => Else | "then" => Then | "fn" => Fn 
                    | _ => Identifier s
                )::tokens,cs2) end
        else if c = #"\"" then
            let val (l,cs2) = readStringLiteral([],cs) 
            in helper(StringLiteral(implode l)::tokens,cs2) end
        else
            let val (t,cs2) = readSymbol(c,cs)
            in helper(t::tokens,cs2) end;
in
    rev(helper([], explode s))
end;

             
fun parseSequence toks = 
    let
        fun helper(exprs, nil) = (exprs,nil)
          | helper(exprs, tok::toks) = 
              case tok of
                RCurly => (exprs,tok::toks)
                   | _ => let val (e, toks2) = parseExpr(tok::toks) in helper(e::exprs,toks2) end;
        val (exprs,toks2) = helper([],toks)
    in
        (SequenceExpr(rev exprs),toks2)
    end

and parseExpr toks = 
    let
      fun consume v [] = raise Exn("expected a token, found eof")
        | consume v ((tok:Token)::toks) = if v = tok then toks else raise Exn("unexpected token in consume");
    
      fun parseLambda(toks) = 
        let
          fun parseArgs(args,tok::toks) = 
                (case tok of Identifier(s) => parseArgs(args @ [s], toks)
                          | Comma => if null(args) then raise Exn("unexpected token") else parseArgs(args,toks)
                          | RParen  => (args,toks)
                          | _ => raise Exn("expected identifier"))
          | parseArgs(args,_) = raise Exn("unexpected eof");
          
          val (args,toks2) = parseArgs([],consume LParen toks);
          val (expr,toks3) = startExpr(0,toks2)
        in (LambdaExpr(args,expr),toks3) end
    
       and
         startExpr(minPrec, tok::toks) = 
            let val (e,toks2) = case tok of 
                Num(n) => (Constant(IntValue n),toks)
              | StringLiteral(s) => (Constant(StringValue s),toks)
              | Fn => parseLambda(toks)
              | If => 
                    let
                        val (e1,toks2) = startExpr(0,toks);
                        val (e2,toks3) = startExpr(0,consume Then toks2);
                        val (e3,toks4) = startExpr(0,consume Else toks3);
                    in (IfExpr(e1,e2,e3),toks4) end 
              | LCurly =>
                    let val (e,toks2) = parseSequence(toks)
                    in (e,consume RCurly toks2) end
              | Identifier(s) => (Variable(s),toks)
              | LParen => 
                    let val (e2,toks2) = startExpr(0,toks)
                    in case toks2 of (RParen::toks) => (e2,toks) | _ => raise Exn("expected Rparen") end
              | _ => raise Exn("Illegal Start of expression " ^ tokDesc(tok));
            in continueExpr(e,minPrec,toks2) end
        | startExpr(_,[]) = raise Exn("No expression found where expression expected")
      and
          continueExpr(e, minPrec,[]) = (e,[])
        | continueExpr(e, minPrec, tok::toks) =
           case tok of OpToken(x) => 
             if prec x < minPrec then (e,tok::toks)
             else let
                val (e2,toks2) = startExpr(prec x + 1,toks)
                
                val e3 = case x of
                    Assign => (case e of Variable(s) => AssignExpr(s,e2) | _ => raise Exn("can only assign to an identifier"))
                       | _ => BinaryExpr(e,x,e2);
             in
                  continueExpr(e3,minPrec,toks2)
             end
           | LParen => let val (exprs,toks2) = parseCall([],toks) in continueExpr(CallExpr(e,exprs),minPrec,toks2) end
           | Then => (e,tok::toks)
           | Else => (e,tok::toks)
           | RParen => (e,tok::toks)
           | Semi => (e,tok::toks)
           | _ => raise Exn("invalid continuation token " ^ tokDesc(tok))
    and
         parseCall(exprs,nil) = raise Exn("Expected token")
       | parseCall(exprs,tok::toks) = 
                case tok of
                    Comma  => if null(exprs) then raise Exn("unexpected token") else parseCall(exprs,toks)
                  | RParen => (exprs,toks)
                  | _ => let val (e,toks2) = startExpr(0,tok::toks) in parseCall(exprs @ [e],toks2) end;
    in
        case startExpr(0,toks) of (e, Semi::toks2) => (e,toks2) | _ => raise Exn("Expected semi")
    end;

            
fun scopeGet(n,ScopeTop) = raise Exn(n ^ " not found in scope")
  | scopeGet(n,ScopeChain(next)) = scopeGet(n,next)
  | scopeGet(n,ScopeVal(k,v,next)) = if k = n then v else scopeGet(n,next);
fun scopePut(k,v,s) = ScopeVal(k,v,s);
            
fun eval (Constant(n),scope) = (n,scope)
  | eval (Variable(s),scope) = (scopeGet(s,scope),scope)
  | eval (AssignExpr(n,e),scope) = let val (v,s2) = eval(e,scope) in (v,scopePut(n,v,s2)) end
  | eval (IfExpr(cond,t,f),scope) = 
        let val (cv,s2) = eval(cond,scope)
        in eval(if toInt(cv) = 0 then f else t, s2) end
  | eval (BinaryExpr(e1,opr,e2),scope) = 
        let
            val (n1,s1) = eval(e1,scope);
            val (n2,s2) = eval(e2,s1);
        in
            ((case opr of
                  Add => (case (n1,n2) of 
                          (StringValue(s),_) => StringValue(s ^ toString(n2))
                        | (_,StringValue(s)) => StringValue(toString(n1) ^ s)
                        | (IntValue(i),IntValue(i2)) => IntValue(i+i2)
                        | _ => let val (i1,i2) = (toInt(n1),toInt(n2)) in IntValue(i1+i2) end
                        )
                 | Equals => IntValue(if (case(n1,n2) of
                            (StringValue(s1),StringValue(s2)) => s1 = s2
                          | (IntValue(i1),IntValue(i2)) => i1 = i2
                          | _ => false
                        ) then 1 else 0)
                 | _ => let val (i1,i2) = (toInt(n1),toInt(n2)) in IntValue(
                            case opr of
                                Sub => i1 - i2
                              | Mul => i1 * i2
                              | Div => i1 div i2
                              | _ => raise Exn("should never happen")
                        ) end
            ),s2)
        end
 | eval (LambdaExpr(args,exprs),scope) = (LambdaValue(args,exprs,scope),scope)
 | eval (CallExpr(func,args),scope) = 
       let 
        val (v,s2) = eval(func,scope)
        
        fun populateScope(nil,_,s) = s
          | populateScope(n::ns,nil,s) = populateScope(ns,nil,scopePut(n,NullValue,s))
          | populateScope(n::ns,v::vs,s) = populateScope(ns,vs,scopePut(n,v,s))
        
        fun runArgs(nil,vals,scope) = (rev vals,scope)
          | runArgs(e::es,vals,scope) = let val (v,s2) = eval(e,scope) in runArgs(es,v::vals,s2) end
          
        val (argVals,s3) = runArgs(args,[],s2)
       in
        case v of
             LambdaValue(argNames,expr,parentScope) => 
                let val (v,_) = eval(expr,scopePut("callee",v,populateScope(argNames,argVals,parentScope)));
                in (v,s3) end
           | NativeLambdaValue(f) => ((f argVals),s3)
           | _ => raise Exn(toString(v) ^ " is not callable")
       end
 | eval(SequenceExpr(exprs),scope) =
    let
        fun helper([],scope,last) = (last,scope)
          | helper(e::es,scope,last) = let val (v,s2) = eval(e,scope) in helper(es,s2,v) end
    in helper(exprs,scope,NullValue) end;


val defaultScope = 
    scopePut("print",   NativeLambdaValue(fn(l) => (TextIO.print (foldleft op^ ("",map toString l)^"\n"); NullValue)),
    scopePut("input",   NativeLambdaValue(fn(l) => (case (TextIO.inputLine TextIO.stdIn) of SOME(s) => StringValue(s) | NONE => NullValue)),
    scopePut("parseInt",NativeLambdaValue(fn(l) => (case l of (v::rest) => IntValue(toInt(v)) | _ => IntValue 0)),
    ScopeTop)));
    
fun runScript s =
    let val (expr,toks) = parseSequence(lex(s))
    in
        if not (null toks) then raise Exn("Trailing garbage")
        else let val (v,_) = eval(expr,defaultScope) in v end
    end;

(
    case SMLofNJ.getArgs() of
        (a0::a1::rest) => 
            (printValue(runScript(TextIO.inputAll(TextIO.openIn(a1))))
                handle Exn(s) => TextIO.print("Error: " ^ s ^ "\n"))
        | _ => TextIO.print("Usage: sml brilang.sml foo.bs\n");

    OS.Process.exit(OS.Process.success)
) : int;