(* Substitution model interpreter for HOILEC *)

module HoilecSubstInterp = struct
 
  open Hoilec
  open List

  exception EvalError of string

  let print = StringUtils.print 
  let println = StringUtils.println

  (* val run : Hoilec.pgm -> int list -> int *)
  let rec run (Pgm(fmls,body)) ints = 
    let flen = length fmls
    and ilen = length ints 
    in 
      if flen = ilen then 
        eval (subst body (Env.make fmls (map (fun i -> Lit i) ints)))
      else 
        raise (EvalError ("Program expected " ^ (string_of_int flen)
                          ^ " arguments but got " ^ (string_of_int ilen)))

  (* val eval : Hoilec.exp -> valu *)
  and eval exp = 
    match exp with 
      Lit v -> v
    | Var name -> raise (EvalError("Unbound variable: " ^ name))
    | PrimApp(op, rands) -> HoilecEnvInterp.primApply op (map eval rands)
    | If(tst,thn,els) -> 
       (match eval tst with 
         Bool true -> eval thn
       | Bool false -> eval els
       | v -> raise (EvalError ("Non-boolean test value " 
				^ (valuToString v)
				^ " in if expression:\n"
				^ (expToString exp)))
       )
    | Abs(fml,body) -> Fun(fml,body,Env.empty) (* make a closure *)
    | App(rator,rand) -> apply (eval rator) (eval rand)
    | Bindrec(names,defns,body) -> 
        let recenv = Env.make names 
                              (map (fun name -> Bindrec(names,defns, Var name))
                                   names)
	in eval (subst body (Env.make names
			              (map (fun defn -> subst defn recenv) defns)))

  and apply fcn arg = 
    match fcn with 
      Fun(fml,body,_) -> eval (subst1 fml (Lit arg) body)
                         (* Converts any argument valu (including functions, pairs, lists) 
                            into a literal for purposes of substitution *)
    | _ -> raise (EvalError ("Non-function rator in application: "
			     ^ (valuToString fcn)))

  (* A function for running programs expressed as strings *)
  let runString pgmString args = 
    run (sexpToPgm (Sexp.stringToSexp pgmString)) args	  

  (* A function for running a programs in a files *)
  let runFile pgmFile args = 
    run (sexpToPgm (Sexp.stringToSexp (File.fileToString pgmFile))) args	  

  (* An interactive read-eval-print loop (REPL) for Hoilec expressions.
     By default, assumes zero arguments, but this can be changed
     with the #args directive (see below). The following directives
     are supported:

     + (#desugar <exp>) prints out the desugared form of <exp>

     + (def <name> <exp>) introduces a top-level binding of <name> to <exp>. 
       This binding is mutually recursive with all other top-level bindings.

     + (def (<name> <fml1> ... <fmln>) <exp>) is sugar for
       (def <name> (fun (<fml1> ... <fmln>) <exp>))

     + (#load "<filename>") loads definitions and other recursive loads
       from file named <filename>.

     + (#quit): Exit the interpreter
   *)

  (* val repl : unit -> unit *)
  let rec repl () =
    let sexpToSymIntPair sexp =   (* sexpToStringIntPair : sexp -> (string * int) *)
      match sexp with 
        Sexp.Seq [Sexp.Sym s; Sexp.Int i] -> (s, i)
      | _ -> raise (Failure "Not an symbol/int pair!") in 
    (* Repl loop carries with it an environment of name/value bindings 
       introduced by DEFs. In this implementation multiple DEFs are *not* mutually
       recursive, but a single DEF is *)
    let rec loop env = 
      let _ = print "\n\nhoilec> " in 
      let sexp = Sexp.readSexp() in 
        try 
          match sexp with 
            Sexp.Seq [Sexp.Sym "#quit"] -> print "\ndone\n"
          | Sexp.Seq [Sexp.Sym "#desugar"; sexp] -> 
	      ((match sexp with 
		Sexp.Seq (Sexp.Sym "def" :: _) -> 
		  print (Sexp.sexpToString (desugarDef sexp))
 	        | _ -> print (Sexp.sexpToString (desugar sexp))); 
	       loop env)
          | Sexp.Seq ((Sexp.Sym "#load" | Sexp.Sym "def") :: _) -> 
	      (* add new bindings to end of binding list *)
	      loop (Env.merge (declToEnv sexp env) env)
          | _ -> (print 
	            (valuToString 
	              (eval (subst (sexpToExp sexp) env)));
                  loop env)
        with 
          EvalError s -> (print ("EvalError: " ^ s); loop env)
        | SyntaxError s -> (print ("SyntaxError: " ^ s); loop env)
        | Sexp.IllFormedSexp s -> (print ("SexpError: " ^ s); loop env)
        | Sys_error s -> (print ("Sys_error: " ^ s); loop env)
    in loop Env.empty

  (* val declToEnv: sexp -> valu Env -> valu Env *)
  and declToEnv decl env = 
    match decl with 
      Sexp.Seq ((Sexp.Sym "def") :: _) -> 
        let ((name,defn) as binding) = defToBinding decl in (* defined in Hoilec.ml *)
          Env.make [name] [eval (subst (Bindrec([name],[defn],Var name)) env)] 
    | Sexp.Seq [Sexp.Sym "#load"; Sexp.Str filename] -> 
      (* filename is required to be a string literal *)
        let _ = println ("Loading " ^ filename) in 
        let env' = fileToEnv filename env in 
        let _ = println ("Done loading " ^ filename)in 
	env'
    | _ -> raise (EvalError ("unrecognized declaration" ^ (Sexp.sexpToString decl)))

  (* val fileToEnv: string -> valu Env -> valu Env *)
  and fileToEnv filename env = 
    let decls = Sexp.fileToSexps filename in 
      ListUtils.foldl Env.empty 
                      (fun e decl -> Env.merge (declToEnv decl e) e)
                      decls


end