#!/home/jbw/jbw-cvs/bin/smlnj-script
(*-*-SML-*-*) (* Tell Emacs to use SML mode even though name does not end with “.sml”. *)
(* #!/usr/bin/env smlnj-script *) (* This is better 1st line if smlnj-script is in your PATH. *)

(* Author of template portion: Joe Wells *)

(**********************************************************************
 * INSTRUCTIONS FOR USING THIS FILE:
 *
 * These instructions assume this file is named Xyzzy.  When reading
 * these instructions, replace Xyzzy in your mind by the actual file
 * name.
 *
 * This is an SML/NJ _*script*_.  You do not need to compile it.  It
 * should be runnable as is.  This means if this file is in the
 * current directory, you should be able to type ./Xyzzy at a shell
 * command prompt and this program will run.  If you put this file in
 * one of the directories listed in your PATH environment variable,
 * then you can run this by just typing “Xyzzy”.
 *
 * There are a few things that can go wrong, and here is a short guide
 * to how to fix them:
 *
 * 1. The permissions on this file might be wrong.  Do “chmod a+rx
 *    Xyzzy” (assuming you own the file).
 *
 * 2. smlnj-script might not be installed anywhere on the computer you
 *    are using.  Install it.
 *
 * 3. If the first line reads “#!/usr/bin/env smlnj-script”, then
 *    “smlnj-script” might not be in any of the directories found via
 *    your PATH environment variable.  Fix your PATH.
 *
 *    Alternatively, if the first line is of the form
 *    “#!/directory/path/to/smlnj-script”, then the path
 *    “/directory/path/to/smlnj-script” might be the wrong path to
 *    smlnj-script.  Fix it.
 *
 * Fuller instructions for smlnj-script can be found in the README
 * file in the smlnj-script git repository.  As of 2016-01, you can
 * find a copy of this repository at
 * /home/jbw/smlnj-script-git/smlnj-script on the UNIX NFS file
 * systems of the Heriot-Watt University Computer Science department.
 * Do “git clone
 * ssh://MACHINE.macs.hw.ac.uk/~jbw/smlnj-script-git/smlnj-script”
 * (where you must replace MACHINE by the name of some machine that
 * works, e.g., linux01 worked for me) to get your own copy of this
 * repository.
 **********************************************************************)

(* *************************)
(*** support for debugging *)
(* *************************)

(* Comments that begin with “*SKALPEL-” help Skalpel, a tool for SML type errors. *)
(* Semicolons after Skalpel magic comments are needed by Skalpel. *)
(**SKALPEL-USE-FILE /home/jbw/smlnj-script-git/smlnj-script/smlnj-script.sml *);

(* structure U = SmlnjScriptUtils; *) (* Already in effect; uncomment to list what is available. *)

(* val () = U.raisePrintingLimitsToMax (); *) (* Uncomment to see into “...” in compiler message. *)

(* val () = U.interact (); *) (* Uncomment where you want to enter an interactive compiling mode. *)

val () = silenceCompiler ();

(* These two help you avoid shooting yourself in the foot. *)
val () = Student.strongerPatternErrorsAndWarnings ();
val () = Student.disableBadPartialFunctions ();

(* This helps you avoid getting a lower mark by violating the prohibition on string building. *)
val () = Student.disableStringBuilding ();

val () = U.clearCompilerOutputStash ();

val () = unsilenceCompiler (); (* Comment when your script is finally completely working. *)

(* *********************************************************************)
(*** utilities for processing mathematical definitions encoded in JSON *)
(* *********************************************************************)

structure J = JSON;

(* The JSON structure represents JSON objects as association lists.  Parse results are not
guaranteed to have object fields in any particular order.  Because this causes difficulty with
pattern matching, the sortJsonFields function is used to sort the JSON object fields.  This also
will help with detecting two fields with the same name (which I suspect the JSON structure
allows). *)
fun sortJsonFields fields =
    ListMergeSort.sort (fn ((key1,value1),(key2,value2)) =>
                           U.isGreater (String.compare (key1,key2)))
                       fields;

(* Error exceptions have (string list) rather than string so as to abide by the prohibition of
run-time string building *)
exception BadJsonMath of J.value * (string list);
exception BadVariableName of string list;

(* Identifies which operators are allowed and how many arguments each expects. *)
val operatorArgSpecs =
    List.concat
        (map (fn (argSpec, operList) =>
                 (map (fn oper => (oper, argSpec))
                      operList))
             [(SOME 1, ["domain", "inverse", "is-function"]),
              (SOME 2, ["pair", "apply-function", "equal", "member", "set-difference", "union"]),
              (SOME 4, ["diagonalize"]),
              (NONE, ["set"])]);

(* Enforces the rules for valid variable names and converts them to integers. *)
fun parseVariableName varName =
    case String.explode varName
     of #"x" :: #"0" :: _ :: _ =>
        raise (BadVariableName ["purported variable name contains character(s) after x0: ",
                                varName])
      | #"x" :: digits =>
        foldl (fn (c as (#"0"|(#"1")|(#"2")|(#"3")|(#"4")|(#"5")|(#"6")|(#"7")|(#"8")|(#"9")),
                   num : IntInf.int)
                  => (num * 10) + (IntInf.fromInt (Char.ord c - Char.ord #"0"))
              | _ =>
                raise (BadVariableName
                           ["purported variable name contains non-digit after the first position: ",
                            varName]))
              (0 : IntInf.int)
              digits
      | _ :: _ => raise (BadVariableName ["purported variable name does not start with x: ",
                                          varName])
      | nil => raise (BadVariableName ["purported variable name is empty string"]);

(* Detects whether a JSON.value is a valid representation of a mathematical expression and if it
is calls one of the 3 functions it is supplied for the different cases.  The “extra” parameter is
way to get information to the 3 functions that might be different for this expression; this is an
alternative to using mutable references or generating fresh functions. *)
fun ('extra,'result)
    caseJsonMathExp
        {intFn : {extra : 'extra, int : IntInf.int}                           -> 'result,
         opFn  : {extra : 'extra, op_name : string, arguments : J.value list} -> 'result,
         varFn : {extra : 'extra, var_num : IntInf.int}                       -> 'result}
        extra
        j =
    case j
     of (J.INT i) => intFn {extra = extra, int = i}
      | (J.OBJECT fields) =>
        (case sortJsonFields fields
          of [("variable", J.STRING varName)] =>
             varFn {extra = extra, var_num = parseVariableName varName}
           | [("variable", _)] =>
             raise (BadJsonMath (j, ["JSON object does not represent a variable reference: ",
                                     "the contents of its field is not a string"]))
           | [("arguments", J.ARRAY args),
              ("operator", J.STRING operName)] => let
               val numArgs = length args
               val maybeArgSpec =
                   Option.map (# 2) (List.find (fn (operName2, argSpec) =>
                                                   operName2 = operName)
                                               operatorArgSpecs)
               val () =
                   case maybeArgSpec
                    of NONE =>
                       raise (BadJsonMath (j, ["JSON object does not represent a math expression: ",
                                               "bad operator name: ", operName]))
                     | SOME NONE => ()
                     | SOME (SOME requiredNumArgs) =>
                       if requiredNumArgs = numArgs
                       then ()
                       else raise (BadJsonMath
                                       (j, ["JSON object does not represent a math expression: ",
                                            "operator ",operName,"requires ",
                                            Int.toString requiredNumArgs,
                                            " arguments but got ",Int.toString numArgs]))
             in opFn {extra = extra, op_name = operName, arguments = args} end
           | [("arguments", J.ARRAY _),
              ("operator", _)] =>
             raise (BadJsonMath (j, ["JSON object does not represent an operation: ",
                                     "the contents of its operator field is not a string"]))
           | [("arguments", _),
              ("operator", J.STRING _)] =>
             raise (BadJsonMath (j, ["JSON object does not represent an operation: ",
                                     "the contents of its arguments field is not an array"]))
           | _ => raise (BadJsonMath (j, ["JSON object does not represent a math expression: ",
                                          "wrong fields"])))
      | _ => raise (BadJsonMath (j, ["JSON value does not represent a math expression: ",
                                     "neither integer nor object"]));

(* Detects whether a JSON.value is a valid representation of a mathematical definition and if it
is calls the function it is supplied with the extracted pieces of the definition *)
fun 'result caseJsonMathDec (decFn : {var_num : IntInf.int, expression : J.value} -> 'result)
                            (j as J.OBJECT fields) =
    (case sortJsonFields fields
      of [("declared-variable", J.STRING var),
          ("value", exp)] =>
         decFn {var_num = parseVariableName var, expression = exp}
       | _ => raise (BadJsonMath (j, ["JSON object does not represent a math declaration: ",
                                      "wrong fields or declared-variable not a string"])))
  | caseJsonMathDec _ j =
    raise (BadJsonMath (j, ["JSON value does not represent a math declaration: not an object"]));

(* Detects whether a JSON.value is a valid representation of a list of mathematical definition
and if it is calls the function it is supplied with the list of definitions. *)
fun 'result caseJsonMathDecList (decListFn : J.value list -> 'result)
            (J.OBJECT [("declaration-list", J.ARRAY decs)]) =
    decListFn decs
  | caseJsonMathDecList _ j =
    raise (BadJsonMath (j, ["JSON value does not represent a math declaration list: ",
                            "not an object or object with wrong fields"]));

(* **************************************************)
(*** example of processing mathematical definitions *)
(* **************************************************)

(* This section is an example of how to traverse a JSON-encoded tree representing mathematical
definitions.  The example also shows how to thread a piece of stateful information through the
traversal using the “extra” parameter of caseJsonMathExp. *)

(***************************************************************************************************
 * NOTICE TO STUDENT: You may use the code above this line provided you carefully mark any changes
 * you make.  You may take inspiration from the code below this line but you should not use it.  You
 * should instead understand it and then write your own code from your understanding.
 * *************************************************************************************************)

datatype NotationTree = INT of IntInf.int | VAR of IntInf.int | PAIR of NotationTree * NotationTree | SET of NotationTree list;

exception BadPair of string;

val file = "output.txt";

fun writeAppendFile fileName content =
	let val fd = TextIO.openAppend fileName
		val _ = TextIO.output (fd, content) handle e => (TextIO.closeOut fd; raise e)
		val _ = TextIO.closeOut fd
	in () end;

fun traverseNotationTree (INT i) = let
		val k = if i < 0 then let
			val () = writeAppendFile "output.txt" "-";
			val () = writeAppendFile "output.txt" (IntInf.toString (abs i));
			in () end
		else writeAppendFile "output.txt" (IntInf.toString  i);
	in k end
  | traverseNotationTree (VAR i) = ()
  | traverseNotationTree (PAIR (x, y)) = let
	 val () = writeAppendFile "output.txt" "(";
	 val () = traverseNotationTree x;
	 val () = writeAppendFile "output.txt" ", ";
	 val () = traverseNotationTree y;
	 val () = writeAppendFile "output.txt" ")";
     in () end
  | traverseNotationTree (SET (hd::tl)) = let
      val () = writeAppendFile "output.txt" "{";
      val () = traverseNotationTree hd;
      fun loop (h::t) = let
	      val () = writeAppendFile "output.txt" ", ";
	      val () = traverseNotationTree h;
	    in loop t end
	    | loop [] = ();
	  val () = loop tl;
	  val () = writeAppendFile "output.txt" "}";
	in () end
  | traverseNotationTree (SET ([])) = writeAppendFile "output.txt" "{}";

fun traverseInt {extra = node, int} = (INT int)

and traverseVar {extra = node, var_num} = (VAR var_num)

and traverseSet node arguments = let
	fun loop node (arg::args)
        = (traverseJsonMathExp node arg)::(loop node args)
      | loop node [] = [];
in (SET (loop node arguments)) end

and traversePair node (hd::tl::[]) = let
in (PAIR (INT 1, INT 2)) end
  | traversePair node _ = (INT 1)

and traverseOp {extra = node, op_name, arguments} = if op_name = "set" then (traverseSet node arguments) else (traversePair node arguments)

and traverseJsonMathExp node exp =
    caseJsonMathExp {intFn = traverseInt, varFn = traverseVar, opFn = traverseOp} node exp;

fun traverseDec node {var_num, expression} = let
	val () = writeAppendFile "output.txt" "Let x";
	val () = writeAppendFile "output.txt" (IntInf.toString var_num);
	val () = writeAppendFile "output.txt" " be ";
	val node2 = traverseJsonMathExp (node + 1) expression;
	val () = traverseNotationTree node2;
	val () = writeAppendFile "output.txt" "\n";
	val () = writeAppendFile "output.txt" "  which is ";
	val () = traverseNotationTree node2;
	val () = writeAppendFile "output.txt" "\n";
	(*val node3 = traverseNotationTree (traverseJsonMathExp node2 expression);*)
in 2 end;

fun traverseDecList decs = let
	fun loop node (d::decs) = loop (caseJsonMathDec (traverseDec node) d) decs
	  | loop _ [] = ();
	val () = loop 2 decs;
in () end;

val input = JSONParser.parseFile "input.json";

val () = caseJsonMathDecList traverseDecList input;