open G_ast
open Support.Pervasive
open Support.Error
open Printf
open Prim
open List

let rec g2string_fun_name n =
  (match n with
    | "__assign" -> "operator="
    | "__increment" -> "operator++"
    | "__decrement" -> "operator--"
    | "__add" -> "operator+"
    | "__sub" -> "operator-"
    | "__star" -> "operator*"
    | "__div" -> "operator/"
    | "__mod" -> "operator%"
    | "__equal" -> "operator=="
    | "__not_equal" -> "operator!="
    | "__less_than" -> "operator<"
    | "__less_equal" -> "operator<="
    | "__greater_than" -> "operator>"
    | "__greater_equal" -> "operator>="
    | "__output" -> "operator<<"
    | "__input" -> "operator>>"
    | "__or" -> "or"
    | "__and" -> "and"
    | "__not" -> "not"
    | "__addr" -> "&"
    | n -> ununiquify_name n)

and g2string_typ t =
  (match t with
    VarT (_,n) -> ununiquify_name n
  | VertexT i -> sprintf "[%d]" i
  | ClassT (_,n,ts) -> 
      if (0 < length ts) then
	sprintf "%s< %s >" (ununiquify_name n)
	  (String.concat ", " (map g2string_typ ts))
      else
	sprintf "%s" n
  | IntT i -> "int"
  | ShortT i -> "short"
  | LongT i -> "long"
  | LongLongT i -> "long long"
  | FloatT i -> "float"
  | DoubleT i -> "double"
  | LongDoubleT i -> "long double"
  | BoolT i -> "bool"
  | StringT i -> "string"
  | CharT i -> "char"
  | WCharT i -> "wchar_t"
  | VoidT i -> "void"
  | PtrT (i,t) -> sprintf "%s*" (g2string_typ t)
  | FunT (_,ts,w,ps,rt) ->
      sprintf "(fun%s%s(%s) %s)"
	(g2string_tparams ts)
	(g2string_where w)
	(String.concat ", " (map g2string_exp_typ ps))
	(g2string_ret_typ rt)
  | NullT _ -> "null_t"
  | AssocT (_,cn,targs,tn) -> sprintf "%s< %s >.%s" cn 
	(String.concat ", " (map g2string_typ targs)) tn
  | OvldT (_,ts) ->
	sprintf "<ovld>{%s}"
	  (String.concat ", "
	     (map (fun (e,t) -> g2string_typ t) ts))

  | UnsignedT (_,t) -> sprintf "unsigned %s" (g2string_typ t)
  | SignedT (_,t) -> sprintf "signed %s" (g2string_typ t)
  | ConstT (_,t) -> sprintf "%s const" (g2string_typ t)
  | ElipsesT _ -> "...")

and g2string_exp_typ et =
  (match et with
    (t, Lvalue, Constant) ->
      sprintf "%s const&" (g2string_typ t)
  | (t, Lvalue, Mutable) ->
      sprintf "%s !&" (g2string_typ t)
  | (t, Rvalue, _) ->
      sprintf "%s @" (g2string_typ t)
  )

and g2string_ret_typ et =
  (match et with
    (t, Lvalue, Constant) ->
      sprintf "-> %s const&" (g2string_typ t)
  | (t, Lvalue, Mutable) ->
      sprintf "-> %s !&" (g2string_typ t)
  | (t, Rvalue, _) ->
      sprintf "-> %s @" (g2string_typ t))

and g2string_exp e =
  match e with
    | NullE _ -> "nullptr"
    | ThisE _ -> "this"
    | IntE (_, n) -> sprintf "%d" n
    | FloatE (_, n) -> sprintf "%f" n
    | DoubleE (_, n) -> sprintf "%f" n
    | BoolE (_, n) -> sprintf "%b" n
    | StringE (_, n) -> sprintf "\"%s\"" (String.escaped n)
    | CharE (_, c) -> sprintf "`%c`" c
    | VarE (_, n) -> g2string_fun_name n
    | FunE (i, ts, ps, rt, inits, body) ->
	sprintf "fun %s(%s) -> %s %s"
	(if (0 < length ts) then
	   sprintf "< %s >" (String.concat ", " (map ununiquify_name ts))
	 else "")
	(String.concat ", " 
	   (map
	      (function (n,t) -> 
		 sprintf "%s %s" (g2string_exp_typ t) 
		 (ununiquify_name n))
	      ps))
	(g2string_exp_typ rt)
	(g2string_stmt body)
    | ApplyE (_, f, args) ->
	sprintf "%s(%s)" (g2string_exp f)
	  (String.concat ", " (map g2string_exp args))
    | InstE (_, e, targs) ->
	sprintf "%s<|%s|>" (g2string_exp e)
	  (String.concat ", " (map g2string_typ targs))
    | PrimE (_, p) -> sprintf "primitive %s" (prim2str p)
    | NewE (_, a, t, args) ->
	(match a with
	     Stack ->
	       sprintf "@%s(%s)" (g2string_typ t)
	       (String.concat ", " (map g2string_exp args))
	   | Heap -> 
	       sprintf "new %s(%s)" (g2string_typ t)
	       (String.concat ", " (map g2string_exp args))
	   | GCHeap -> 
	       sprintf "new GC %s(%s)" (g2string_typ t)
		 (String.concat ", " (map g2string_exp args)))
    | PlacementNewE (_, p, t, args) ->
	sprintf "new (%s) %s(%s)" 
	  (g2string_exp p)
	  (g2string_typ t)
	  (String.concat ", " (map g2string_exp args))
    | NewArrayE (_, a, t, e) ->
	(match a with
	     Stack ->
	       sprintf "@%s[%s]" (g2string_typ t) (g2string_exp e)
	   | Heap -> 
	       sprintf "new %s[%s]" (g2string_typ t)
	       (g2string_exp e)
	   | GCHeap -> 
	       sprintf "new GC %s[%s]" (g2string_typ t)
		 (g2string_exp e))
    | NewArrayNoInitE (_, a, t, e) ->
	(match a with
	     Stack ->
	       sprintf "@^%s[%s]" (g2string_typ t) (g2string_exp e)
	   | Heap -> 
	       sprintf "new^ %s[%s]" (g2string_typ t)
	       (g2string_exp e)
	   | GCHeap -> 
	       sprintf "new^ GC %s[%s]" (g2string_typ t)
		 (g2string_exp e))
    | DeleteE (_, e) ->
	sprintf "delete %s" (g2string_exp e)

    | DestroyE (_, e) ->
	sprintf "destroy %s" (g2string_exp e)
	  
    | SizeofE (_, t) ->
	sprintf "sizeof<%s>" (g2string_typ t)

    | StructE (i, a, sn, targs, inits) ->
	let targs = (map g2string_typ targs) in
	let targs = 
	  if targs = [] then "" 
	  else sprintf "< %s >" (String.concat ", " targs) in
	let st = sprintf "%s%s" sn targs in
	let inits = String.concat ", " 
		      (map (fun (n,e) -> 
			      sprintf "%s = %s" n (g2string_exp e))
			 inits) in
	(match a with
	     Stack ->
	       sprintf "@%s{%s}" st inits
	   | Heap -> 
	       sprintf "new %s{%s}" st inits
	   | GCHeap -> 
	       sprintf "new GC %s{%s}" st inits)
	  
    | MemE (_, e, m) ->
	sprintf "%s.%s" (g2string_exp e) m
    | ModelMemE (_, cn, targs, m) ->
	sprintf "%s< %s >.%s" cn (String.concat ", " (map g2string_typ targs)) m
    | IfE (_, e, thn, els) ->
	sprintf "(%s ? %s : %s)"
	  (g2string_exp e)
	  (g2string_exp thn)
	  (g2string_exp els)
    | SeqE (_, es) ->
	String.concat ", " (map g2string_exp es)

and g2string_stmt s =
  (match s with
    LetS (i,_,n,e) -> 
      sprintf "let %s = %s;" n (g2string_exp e)
  | TypedefS (i, n, t) -> 
      sprintf "type %s = %s;" n (g2string_typ t)
  | ExprS (i, e) -> 
      sprintf "%s;" (g2string_exp e)
  | ReturnS (i, None) ->
      "return;"
  | ReturnS (i, Some e) ->
      sprintf "return %s;" (g2string_exp e)
  | IfS (i, c, thn, els) ->
      sprintf "if (%s) %s else %s"
	(g2string_exp c) (g2string_stmt thn) (g2string_stmt els)
  | WhileS (i, c, b) ->
      sprintf "while (%s) %s" (g2string_exp c) (g2string_stmt b)
  | CompoundS (i, ss) -> 
      sprintf "{\n%s\n}"
	(String.concat "\n" (map g2string_stmt ss))
  | SwitchS (i, e, cs) ->
      sprintf "switch (%s) {\n%s\n}"
	(g2string_exp e)
	(String.concat "\n"
	   (map (fun (n,s) ->
	     sprintf "case %s:\n%s" n (g2string_stmt s))
	      cs))
  | ImportS (i, e, path, n) ->
      "import;")

and g2string_req (cn,targs) =
  sprintf "%s< %s >" cn (String.concat ", " (map g2string_typ targs))


and g2string_tparams ts = 
  if ts = [] then "" 
  else sprintf "< %s >" (String.concat ", " (map ununiquify_name ts))


and g2string_where (rs,ss) = 
  if (rs,ss) = ([],[]) then "" 
  else
    sprintf " where { %s }"
      (String.concat ", "
	 ((map g2string_req rs)
	  @
	  (map (fun (s,t) -> 
	    sprintf "%s == %s" (g2string_typ s)
	      (g2string_typ t)) ss)))

and g2string_params ps =
  String.concat ", " 
    (map (fun (n,t) -> 
      sprintf "%s %s" (g2string_exp_typ t) (ununiquify_name n))
       ps)

and g2string_decl d =
  (match d with
    LetD (i,t,_,n,e) ->
      sprintf "let %s = %s;" n (g2string_exp e)
  | LetFwdD (i,t,mut,n) -> 
      sprintf "extern %s %s;" (g2string_exp_typ (t,Lvalue,mut)) n
  | EmptyD -> ""
  | TypedefD (i, n, t) ->
      sprintf "type %s = %s;" n (g2string_typ t)
  | FunD (i, n, recur, ts, w, ps, rt, body) ->
      sprintf "fun %s%s%s\n%s\n(%s) %s\n%s"
	(g2string_fun_name n)
	(if recur then "" else " *")
	(g2string_tparams ts)
	(g2string_where w)
	(g2string_params ps)
	(g2string_ret_typ rt)
	(g2string_stmt body)
  | ExternScopeD (i, n, ds) ->
      sprintf "extern \"%s\" { %s }" n (String.concat "\n" (map g2string_decl ds))
  | FunFwdD (i, n, ts, w, ps, rt) ->
      sprintf "fun %s%s%s\n(%s) %s;"
	(g2string_fun_name n)
	(g2string_tparams ts)
	(g2string_where w)
	(g2string_params ps)
	(g2string_ret_typ rt)
  | ExternFunFwdD (i, lang, n, ts, w, ps, rt) ->
      sprintf "extern \"%s\" %s" lang
	(g2string_decl (FunFwdD (i, n, ts, w, ps, rt)))
  | PrimD (i, p, ts, ps, rt) ->
      sprintf "primitive %s%s(%s) %s;"
	(prim2str p)
	(g2string_tparams ts)
	(g2string_params ps)
	(g2string_ret_typ rt)
  | OvldD (i, n, e) -> 
      sprintf "fun %s += %s;" (g2string_fun_name n) (g2string_exp e)
  | ClassFwdD (i, n, ts, w) -> 
      sprintf "class %s%s%s;" n 
	(g2string_tparams ts)
	(g2string_where w)
  | StructFwdD (i, n, ts, w) -> 
      sprintf "struct %s%s%s;" n 
	(g2string_tparams ts)
	(g2string_where w)
  | UnionFwdD (i, n, ts, w) -> 
      sprintf "union %s%s%s;" n 
	(g2string_tparams ts)
	(g2string_where w)
  | StructD (i, n, ts, w, ms) -> 
      sprintf "struct %s%s%s {\n%s\n};" n 
	(g2string_tparams ts)
	(g2string_where w)
	(String.concat "\n"
	   (map (fun (n,t) ->
	     sprintf "%s %s;" (g2string_typ t) n)
	      ms))
  | UnionD (i, n, ts, w, ms) -> 
      sprintf "union %s%s%s {\n%s\n};" n 
	(g2string_tparams ts)
	(g2string_where w)
	(String.concat "\n"
	   (map (fun (n,t) ->
	     sprintf "%s %s;" (g2string_typ t) n)
	      ms))
  | ClassD (i, n, ts, w, ms, cs, dest) -> 
      sprintf "class %s%s%s {\n%s\n%s\n%s\n};" n 
	(g2string_tparams ts)
	(g2string_where w)
	(String.concat "\n"
	   (map (fun (n,t) ->
	     sprintf "%s %s;" (g2string_typ t) n)
	      ms))
	(String.concat "\n"
	   (map (fun (i,ts,w,ps,inits,body) ->
	     sprintf "%s%s%s(%s)%s%s"
	       (g2string_tparams ts)
	       (g2string_where w)
	       n
	       (g2string_params ps)
	       (if inits = [] then ""
	       else sprintf ": %s"
		   (String.concat ", "
		      (map (fun (n,es) ->
			sprintf "%s(%s)" n 
			  (String.concat ", " (map g2string_exp es)))
			 inits)))
	       (g2string_stmt body))
	      cs))
	(sprintf "~%s() %s"
	   n (g2string_stmt dest))
  | ConceptD (i, n, ts, assocs, refs, reqs, fs, ss) ->
      sprintf "concept %s%s {\n%s\n%s\n%s\n%s\n%s\n};"
	n
	(g2string_tparams ts)
	(String.concat "\n"
	   (map (fun n ->
	     sprintf "type %s;" n)
	      assocs))
	(String.concat "\n"
	   (map (fun (cn,targs) ->
	     sprintf "refines %s< %s >;" cn 
	       (String.concat ", " (map g2string_typ targs)))
	      refs))
	(String.concat "\n"
	   (map (fun (cn,targs) ->
	     sprintf "require %s< %s >;" cn 
	       (String.concat ", " (map g2string_typ targs)))
	      reqs))
	(String.concat "\n"
	   (map
	      (fun (n, (ft, pn, body)) ->
		(match ft with
		  FunT (i, ts, w, ps, rt) ->
		    (match body with
		      None ->
			g2string_decl
			  (FunFwdD (i, n, ts, w, combine pn ps, rt))
		    | Some body ->
			g2string_decl
			  (FunD (i, n, true, ts, w, combine pn ps, rt, body)))
		| _ -> error i "expected function type"))
	      fs))
	(String.concat "\n"
	   (map (fun (s,t) -> 
	     sprintf "%s == %s;" (g2string_typ s)
	       (g2string_typ t)) ss))
  | ModelD (i, opn, ts, w, n, targs, assocs, fs) ->
      sprintf "%smodel %s%s\n%s< %s > {\n%s\n%s\n};"
	(if opn then "open " else "")
	(g2string_tparams ts)
	(g2string_where w)
	n
	(String.concat ", " (map g2string_typ targs))
	(String.concat "\n"
	   (map (fun (n,t) ->
	     sprintf "type %s = %s;" n (g2string_typ t)) assocs))
	(String.concat "\n" 
	   (map (fun (n,(i,recur,ts,w,ps,rt,body)) ->
	     g2string_decl (FunD (i,n,recur,ts,w,ps,rt,body)))
	      fs))
  | ModelFwdD (i, opn, ts, w, n, targs, assocs) ->
      sprintf "model %s%s\n%s< %s > %s[\n%s\n];"
	(g2string_tparams ts)
	(g2string_where w)
	n
	(String.concat ", " (map g2string_typ targs))
	(if opn then "open " else "")
	(String.concat "\n"
	   (map (fun (n,t) ->
	     sprintf "type %s = %s;" n (g2string_typ t)) assocs))
  | ModuleD (i, n, ts, w, ds) ->
      sprintf "module %s%s%s {\n%s\n}"
	n
	(g2string_tparams ts)
	(g2string_where w)
	(String.concat "\n" (map g2string_decl ds))
  | PrivateD i -> 
      sprintf "private:"
  | PublicD i ->
      sprintf "public:"
  | ImportD (i, e, path, n) ->
      sprintf "import;"
  | IncludeD (i, fn) ->
      sprintf "include_c \"%s\";" fn
  | UseD (i, fn) -> 
      sprintf "use \"%s\";" fn)