(*
 * Author:
 *   Guido Tack <tack@ps.uni-sb.de>
 *
 * Copyright:
 *   Guido Tack, 2003
 *
 *  See the file "LICENSE" for information on usage and
 *  redistribution of this file, and for a
 *     DISCLAIMER OF ALL WARRANTIES.
 *
 * Last change:
 *   $Date: 2006/07/19 13:50:24 $ by $Author: tack $
 *   $Revision: 1.16 $
 *)

import structure DescParser from "DescParser"

structure Generator =
  struct
  open DescParser

  exception GeneratorError of string

  fun noOfArgs (NONE | SOME "Space") = 1
    | noOfArgs _ = 2

  fun outputDefine(f, noOfArgs, name) =
      (TextIO.output(f, "DEFINE"^Int.toString noOfArgs^"("^name^") {\n");
       TextIO.output(f, "  DBGMSG(\""^name^"\");\n"))

  fun outputEnd f = TextIO.output(f, "} END\n\n")

  fun outputDeclSpace f =
      (TextIO.output(f, "  DECLARE_SPACE(s, stamp, pstamp, x0);\n");
       TextIO.output(f, "  CHECK_SPACE(s);\n"))

  fun outputIntSet(n, f) =
      let val n = Int.toString n in
          TextIO.output(f,
            "  DECLARE_VECTOR(v"^n^", x"^n^");\n" ^
            "  int noOfPairs"^n^" = v"^n^"->GetLength();\n" ^
            "  int pairs"^n^"[noOfPairs"^n^"][2];\n\n" ^
	    "  {\n" ^
            "  int lastMax = Limits::Set::int_min-1;\n" ^
            "  for (int j=0; j<noOfPairs"^n^"; j++) {\n" ^
            "    DECLARE_TUPLE(tmp, v"^n^"->Sub(j));\n" ^
            "    DECLARE_INT(tmp0, tmp->Sel(0));\n" ^
            "    DECLARE_INT(tmp1, tmp->Sel(1));\n" ^
            "    if (tmp0>tmp1 || tmp0<=lastMax)\n" ^
            "      RAISE(UnsafeGecode::InvalidDomainConstructor);\n" ^
            "    lastMax = tmp1;\n" ^
            "    pairs"^n^"[j][0] = tmp0;\n" ^
            "    pairs"^n^"[j][1] = tmp1;\n" ^
            "  }\n" ^
	    "  }\n" ^
            "  IntSet ds"^n^"(pairs"^n^", noOfPairs"^n^");\n")
      end

  fun outputIntRel(n, f) =
      let val n = Int.toString n in
          TextIO.output(f, "  DECLARE_INT(intrel"^n^", x"^n^");\n")
      end

  fun outputSetRel(n, f) =
      let val n = Int.toString n in
          TextIO.output(f, "  DECLARE_INT(setrel"^n^", x"^n^");\n")
      end

  fun outputSetOp(n, f) =
      let val n = Int.toString n in
          TextIO.output(f, "  DECLARE_INT(setop"^n^", x"^n^");\n")
      end

  fun outputConlevel(n, f) =
      let val n = Int.toString n in
          TextIO.output(f, "  DECLARE_INT(cl"^n^", x"^n^");\n")
      end

  fun outputInt(n, f) =
      let val n = Int.toString n in
          TextIO.output(f, "  DECLARE_INT(i"^n^", x"^n^");\n")
      end
  

  fun outputDescription(n, f) =
      let val n = Int.toString n in
          TextIO.output(f, "  DECLARE_DESCRIPTION(desc"^n^", x"^n^");\n")
      end

  fun outputIntArgs(n, f) =
      let val n = Int.toString n in
          TextIO.output(f,
            "  DECLARE_VECTOR(v"^n^", x"^n^");\n" ^            
            "  int noOfArgs"^n^" = v"^n^"->GetLength();\n" ^
            "  if (noOfArgs"^n^"==0) RETURN_UNIT;\n" ^
            "  IntArgs args"^n^"(noOfArgs"^n^");\n" ^
            "  for (int i=noOfArgs"^n^"; i--;) {\n" ^
            "    DECLARE_INT(tmp, v"^n^"->Sub(i));\n" ^
            "    args"^n^"[i] = tmp;\n" ^
            "  }\n")
      end

  fun outputUIntArgs(n,f) =
      let val n = Int.toString n in
          TextIO.output(f, "  DECLARE_INT(i"^n^", x"^n^");\n"^
                           "  if (i"^n^"<0) RAISE(PrimitiveTable::General_Domain);\n")
      end

  fun outputBoolArgs(n,f) =
      let val n = Int.toString n in
          TextIO.output(f, "  DECLARE_BOOL(i"^n^", x"^n^");\n")
      end

  fun outputValSelArgs(n,a,f) =
      let val n = Int.toString n in
          TextIO.output(f, "  DECLARE_INT(varValSel"^n^", x"^n^");\n")
      end

  fun outputVarDec(n,f,IntVar) =
      TextIO.output(f, "  DECLARE_INTVAR(var"^Int.toString n^
                       ", s, stamp, pstamp, x"^Int.toString n^");\n")
    | outputVarDec(n,f,BoolVar) =
      TextIO.output(f, "  DECLARE_BOOLVAR(var"^Int.toString n^
                       ", s, stamp, pstamp, x"^Int.toString n^");\n")
    | outputVarDec(n,f,SetVar) =
      TextIO.output(f, "  DECLARE_SETVAR(var"^Int.toString n^
                       ", s, stamp, pstamp, x"^Int.toString n^");\n")
    | outputVarDec(n,f,List v) =
      let 
          val n = Int.toString n 
          val typ = case v of IntVar => "Int"
                            | BoolVar => "Bool"
                            | SetVar => "Set"
                            | _ => raise GeneratorError "outputVarDec: Int,Bool,Set allowed"
          val typU = case v of IntVar => "INT"
                            | BoolVar => "BOOL"
                            | SetVar => "SET"
                            | _ => raise GeneratorError "outputVarDec: INT,BOOL,SET allowed"
      in
          TextIO.output(f, 
                        "  DECLARE_VECTOR(v"^n^", x"^n^");\n"^
                        "  int noOfVars"^n^" = v"^n^"->GetLength();\n"^
                        "  "^typ^"VarArgs vars"^n^"(noOfVars"^n^");\n"^
                        "  for (int i=noOfVars"^n^"; i--;) {\n"^
                        "    DECLARE_"^typU^"VAR(tmp, s, stamp, pstamp, v"^n^"->Sub(i));\n"^
                        "    vars"^n^"[i] = tmp;\n"^
                        "  }\n")
      end


  fun outputInArgs n f nil = ()
    | outputInArgs n f ((Var v)::ar) =
      (outputVarDec(n, f, v);
       outputInArgs (n+1) f ar)
    | outputInArgs n f (IntSet::ar) =
      (outputIntSet(n,f);outputInArgs (n+1) f ar)
    | outputInArgs n f (IntRel::ar) =
      (outputIntRel(n, f); outputInArgs (n+1) f ar)
    | outputInArgs n f (SetRel::ar) =
      (outputSetRel(n, f); outputInArgs (n+1) f ar)
    | outputInArgs n f (SetOp::ar) =
      (outputSetOp(n, f); outputInArgs (n+1) f ar)
    | outputInArgs n f (IntConLevel::ar) =
      (outputConlevel(n,f); outputInArgs (n+1) f ar)
    | outputInArgs n f (Int::ar) =
      (outputInt(n,f); outputInArgs (n+1) f ar)
    | outputInArgs n f (IntArgs::ar) = 
      (outputIntArgs(n,f); outputInArgs (n+1) f ar)
    | outputInArgs n f (UInt::ar) = 
      (outputUIntArgs(n,f); outputInArgs (n+1) f ar)
    | outputInArgs n f (Bool::ar) =
      (outputBoolArgs(n,f); outputInArgs (n+1) f ar)
    | outputInArgs n f
      ((a as (AvalSel|BvalSel|BvarSel|SetBvalSel|SetBvarSel)::ar)) =
      (outputValSelArgs(n,a,f); outputInArgs (n+1) f ar)
    | outputInArgs n f (Description::ar) =
      (outputDescription(n,f); outputInArgs (n+1) f ar)
    | outputInArgs n f (Void::ar) = outputInArgs (n+1) f ar
    | outputInArgs n f ((Iterator _)::ar) = outputInArgs (n+1) f ar
    | outputInArgs n f ((Other s)::ar) = outputInArgs (n+1) f ar
    | outputInArgs _ _ _ = raise GeneratorError "Unknown InArgs"

  fun getVarName (i, arg) =
      let val n = Int.toString (i+1) in
          case arg of Var (List _) => "vars"^n
                    | Var _ => "var"^n
                    | IntSet => "ds"^n
                    | IntRel => "UnsafeGecode::int2intreltype[intrel"^n^"]"
                    | SetRel => "UnsafeGecode::int2setreltype[setrel"^n^"]"
		    | SetOp => "UnsafeGecode::int2setoptype[setop"^n^"]"
                    | IntConLevel => "UnsafeGecode::int2cl[cl"^n^"]"
                    | Int => "i"^n
                    | UInt => "i"^n
                    | IntArgs => "args"^n
                    | Bool => "i"^n
                    | Void => ""
                    | AvalSel => "UnsafeGecode::int2avalsel[varValSel"^n^"]"
                    | BvalSel => "UnsafeGecode::int2bvalsel[varValSel"^n^"]"
                    | BvarSel => "UnsafeGecode::int2bvarsel[varValSel"^n^"]"
                    | SetBvalSel =>
                      "UnsafeGecode::int2fsbvalsel[varValSel"^n^"]"
                    | SetBvarSel =>
                      "UnsafeGecode::int2fsbvarsel[varValSel"^n^"]"
                    | Iterator "I&" => "is"^n
                    | Iterator _ => raise GeneratorError "Unknown Iterator"
                    | Description => "desc"^n
                    | Other s => "?!?!?!?"
                    | _ => raise GeneratorError "Unknown arg"
      end

  fun putCommas [a] = a
    | putCommas nil = ""
    | putCommas (a::ar) = a^","^putCommas ar

  fun toUpper s = String.implode (map Char.toUpper (String.explode s))

(*All non-method functions in the gecode API explicitly take a space pointer. 
  It is not listed in the dsc file.
  The only exception is the invocation of the fail() method of the parent Space, 
  luckily the only void/void function, see hack below. 
*)
  fun outputCall(f, class, fname, inargs, outarg) =                
      let
          val args = putCommas (List.mapi getVarName inargs)
      in
           (case (class,outarg) of
             (NONE, Void) =>
             TextIO.output(f, 
                           "    "^fname^"(s,"^args^");\n"^
                           "    RETURN_UNIT;\n")
           | (NONE, (Int|UInt)) =>
             TextIO.output(f, "    RETURN_INT("^fname^"(s,"^args^"));\n")
           | (NONE, Bool) =>
             TextIO.output(f, "    RETURN_BOOL("^fname^"(s,"^args^"));\n")
           | (SOME "Space", Var v) =>
             let val typ = case v of IntVar => "intvar"
                                   | BoolVar => "boolvar"
                                   | SetVar => "setvar"
                                   | _ => raise GeneratorError "one of intvar,boolvar,setvar expected"
             in
                 TextIO.output(f, "    RETURN_GECODE_VAR(s->new_"^typ^"("^
                                  args^"), stamp, pstamp);\n")
             end
           | (SOME "Space", Void) =>
             TextIO.output(f, "    s->"^fname^"("^args^");\n"^
                              "    RETURN_UNIT;\n")
           | (SOME (("IntVar"|"SetVar") as cl), typ) =>
             (TextIO.output(f, "    DECLARE_"^toUpper cl^"(var1"^
                               ", s, stamp, pstamp, x1);\n");
              case typ of Void =>
                          TextIO.output(f, 
                                        "    var1."^fname^"("^args^");\n"^
                                        "    RETURN_UNIT;\n")
                        | (Int|UInt) =>
                          TextIO.output(f, "    RETURN_INT(var1."^fname^"("^args^"));\n")
                        | Bool =>
                          TextIO.output(f, "    RETURN_BOOL(var1."^fname^"("^args^"));\n")
                        | Iterator s =>
                          TextIO.output(f, "    unsigned int retIterSize = 0;\n"^
                                           "    for("^s^" iters(var1);\n"^
                              "        iters(); ++iters) retIterSize++;\n"^
                              "    "^s^" ret(var1);\n"^
                              "    Vector *vret = Vector::New(retIterSize);\n"^
                              "    if(retIterSize>0) {\n"^
                              "      u_int count = 0;\n"^
                              "      for (; ret(); ++ret) {\n"^
                              "        Tuple *t = Tuple::New(2);\n"^
                              "        t->Init(0, Store::IntToWord(ret.min()));\n"^
                              "        t->Init(1, Store::IntToWord(ret.max()));\n"^
                              "        vret->Init(count, t->ToWord());\n"^
                              "        count++;\n"^
                              "      }\n"^
                              "    }\n"^
                              "    RETURN(vret->ToWord());\n"
                              )
                        | _ => raise Match (* should not occur *)
                          )
           | (SOME s, _) => raise GeneratorError ("Strange combination of class "^s^" and type detected")
                             )
      end

  fun outputTry f = TextIO.output(f, "  try {\n")
  fun outputCatch f = TextIO.output(f, "  } catch (Exception e) {\n"^
                                       "    RAISE(UnsafeGecode::InternalExceptionConstructor);\n  }\n")

  fun outputDesc(f, _, nil) = ()
    | outputDesc(f, class, (DECL (fname, (inargs, outarg), aliceName))::rest) =
      ((case inargs of [Void] =>
                       outputDefine(f, noOfArgs class, aliceName)
                     | _ => outputDefine(f, List.length inargs + noOfArgs class, aliceName));
       outputDeclSpace f;
       outputInArgs 1 f inargs;
       outputTry(f);
       outputCall(f, class, fname, inargs, outarg);
       outputCatch(f);
       outputEnd f;
       outputDesc(f, class, rest))
    | outputDesc(f, _, (CLASS (n,decls))::rest) = (outputDesc(f, SOME n, map DECL decls);
                                                    outputDesc(f, NONE, rest))


  datatype binding = Exn of string | Fun of string * int * args list * args * string
      
  fun generateBinding'(cls, ((DECL (name, ([Void], outarg), aliceName))::r)) =
      Fun(name, noOfArgs cls, [Space], outarg, aliceName)::generateBinding'(cls,r)
    | generateBinding'(cls, (DECL (name, (inargs, outarg), aliceName))::r) =
      Fun(name, List.length inargs + (noOfArgs cls),
          Space::inargs, outarg, aliceName)::
      generateBinding'(cls, r)
    | generateBinding'(_,(CLASS (n,decls))::r) =
      (generateBinding'(SOME n, map DECL decls))@generateBinding'(NONE, r)
    | generateBinding'(_,nil) = nil

  fun generateBinding decls = generateBinding'(NONE, decls)

  fun calcRecordSize binding =
      foldl (fn (Exn _, i) => i+2 | (Fun _,i) => i+1) 0 binding

  fun outputExn(f, s) =
      (TextIO.output(f, 
          "  record->Init(\"'"^s^"\", UnsafeGecode::"^s^"Constructor);\n");
       TextIO.output(f,
          "  record->Init(\""^s^"\", UnsafeGecode::"^s^"Constructor);\n"))

  fun outputFun(f, (_ , arity, _, _, aliceName)) =
      (TextIO.output(f,
          "  INIT_STRUCTURE(record, \"UnsafeGecode\", \""^aliceName^"\",\n");
       TextIO.output(f,
          "                 "^aliceName^", "^Int.toString arity^");\n"))

  fun outputBinding(f, binding) =
      let
          val size = Int.toString (calcRecordSize binding)
      in
          TextIO.output(f, "word InitComponent() {\n");
          TextIO.output(f, "  UnsafeGecode::init();\n");
          TextIO.output(f, "  Record *record = Record::New("^size^");\n");
          app (fn Exn args => outputExn(f, args)
                | Fun args => outputFun(f, args)) binding;
          TextIO.output(f, "  RETURN_STRUCTURE(\"UnsafeGecode$\", record);\n");
          TextIO.output(f, "}\n")
      end

  fun outputHeader(f, filename) =
      (TextIO.output(f, "// This is a generated file. Do not edit!\n");
       TextIO.output(f, "// Original source: "^filename^".dsc\n\n");
       TextIO.output(f, "#include \""^filename^"Special.hh\"\n\n"))

  fun outputAsigExn(f, s) =
      TextIO.output(f, "    exception "^s^"\n")

  fun addMark true = "'"
    | addMark false = ""
  fun argToType add (Var IntVar) = (addMark add)^"intvar"
    | argToType add (Var BoolVar) = (addMark add)^"boolvar"
    | argToType add (Var SetVar) = (addMark add)^"setvar"
    | argToType add (Var (List IntVar)) = (addMark add)^"intvar vector"
    | argToType add (Var (List BoolVar)) = (addMark add)^"boolvar vector"
    | argToType add (Var (List SetVar)) = (addMark add)^"setvar vector"
    | argToType add IntSet = (addMark add)^"domain"
    | argToType add IntRel = (addMark add)^"intrel"
    | argToType add SetRel = (addMark add)^"setrel"
    | argToType add SetOp = (addMark add)^"setop"
    | argToType add IntConLevel = (addMark add)^"intconlevel"
    | argToType add Int = "int"
    | argToType add IntArgs = "int vector"
    | argToType add UInt = "int"
    | argToType add Bool = "bool"
    | argToType add Void = "unit"
    | argToType add (Iterator s) = (addMark add)^"domain"
    | argToType add AvalSel = (addMark add)^"avalsel"
    | argToType add BvalSel = (addMark add)^"bvalsel"
    | argToType add BvarSel = (addMark add)^"bvarsel"
    | argToType add SetBvalSel = (addMark add)^"setbvalsel"
    | argToType add SetBvarSel = (addMark add)^"setbvarsel"
    | argToType add Space = (addMark add)^"space"
    | argToType add Status = (addMark add)^"status"
    | argToType add Description = (addMark add)^"description"
    | argToType add (Other s) = (print s;raise GeneratorError
                                           ("argToType failed: "^s))

  fun putStars [a] = a
    | putStars nil = ""
    | putStars (a::ar) = a^" * "^putStars ar

  fun outputAsigFun(f, (noOfArgs, args, outarg, aliceName)) =
      TextIO.output(f, "    val "^aliceName^" : "^
                       (putStars (map (argToType true) args))^
                       " -> "^argToType true outarg^"\n")

  fun outputAsig(f, binding) =
      (TextIO.output(f, "signature GC_SIG =\nsig\n");
       TextIO.output(f, "  structure UnsafeGecode : sig\n");
       app (fn Exn args => outputAsigExn(f, args)
             | Fun (_, n,inargs,outarg,aliceName) =>
               outputAsigFun(f, (n, inargs, outarg, aliceName))) binding;
       TextIO.output(f, "  end\nend\n")
       )

  fun generate()=
      let
          val stdBinding =
              [Exn "InvalidSpace",
               Exn "InvalidVar",
               Exn "InvalidDomain",
               Exn "Description",
               Exn "InternalException",
               Fun ("makespace", 0, [Void], Space, "makespace"),
               Fun ("status", 1, [Space], Status, "status"),
               Fun ("clone", 1, [Space], Space, "clone"),
               Fun ("discard", 1, [Space], Void, "discard"),
               Fun ("alive", 1, [Space], Bool, "alive"),
               Fun ("fail", 1, [Space], Void, "fail"),
               Fun ("int_getRanges", 2, [Space,Var IntVar], Iterator "blub", "int_getRanges")
               ]
          val f = TextIO.openOut ("UnsafeGecode.cc")
          val asig = TextIO.openOut ("UnsafeGecode.asig")
          val desc = DescParser.parseFile ("UnsafeGecode.dsc")
          val binding = stdBinding@(generateBinding desc)
      in
          outputHeader(f, "UnsafeGecode");
          outputDesc(f, NONE, desc);
          outputBinding(f, binding);
          TextIO.closeOut f;
          outputAsig(asig, binding);
          TextIO.closeOut asig
      end

  end
