open Cpp_ast
open Support.Pervasive
open Support.Error
open Printf
open Prim

let rec cpp2str ds = 
  String.concat ""
    [(String.concat "\n" (List.map cpp2str_decl ds));
    "\n"]

and cpp2str_alloc a =
  match a with
      Heap -> ""
    | GCHeap -> "(GC) "
    | Stack -> "(STACK) "

and cpp2str_class_mem cn m =
  match m with
      Field (n,t) ->
	sprintf "%s %s;" (cpp2str_typ t) (flatten_name n)
    | Constructor (k, ps, inits, body) ->
	let ps = List.map (fun (n,t) -> sprintf "%s %s" (cpp2str_typ t) (flatten_name n)) ps in
	let ps = 
	  if k >= 0 then
	    ps@[sprintf "boost::mpl::int_<%d>" k] 
	  else ps in
	let ps = String.concat ",\n" ps in
	let init = String.concat ",\n" 
		     (List.map
			(function (n,es) -> 
			   (match es with
				[ClassE (a, cn, k, args)] when n = cn -> (* initializing base class *)
				  cpp2str_exp (ClassE (a, cn, k, args))
			      | _ ->
				  sprintf "%s(%s)" (flatten_name n) (String.concat ", " (List.map cpp2str_exp es))))
			inits) in
	let inits = 
	  if (0 < List.length inits) then
	    sprintf ": %s" init
	  else "" in
	let body = cpp2str_stmt body in
	  sprintf "%s(%s)%s\n%s" cn ps inits body
    | Destructor body ->
	sprintf "~%s()\n%s" cn (cpp2str_stmt body)
    | Method (mn, virt, ps, rt, body) ->
	let virt = if virt then "virtual " else "" in
	let rt = cpp2str_typ rt in
	let ps = List.map (function (n,t) -> sprintf "%s %s" (cpp2str_typ t) (flatten_name n)) ps in
	let ps = String.concat ",\n" ps in
	let body = cpp2str_stmt body in
 	  sprintf "%s%s %s(%s)\n%s" virt rt mn ps body
    | MethodFwd (mn, virt, ps, rt) ->
	let virt = if virt then "virtual " else "" in
	let rt = cpp2str_typ rt in
	let ps = List.map (function (n,t) -> sprintf "%s %s" (cpp2str_typ t) (flatten_name n)) ps in
	let ps = String.concat ",\n" ps in
 	  sprintf "%s%s %s(%s);" virt rt (flatten_name mn) ps
    | Enum (n,ns) ->
	sprintf "enum %s { %s };" (flatten_name n) (String.concat ", " ns)

and cpp2str_decl d =
  match d with
    VarD (t, n, e) ->
      let t = cpp2str_typ t in
      let e = cpp2str_exp e in
	sprintf "%s %s = %s;" t (flatten_name n) e
    | VarFwdD (t, n) ->
      let t = cpp2str_typ t in
	sprintf "extern %s %s;" t (flatten_name n)
  | FunD (n, ps, rt, body) ->
	let rt = cpp2str_typ rt in
	let ps = String.concat ",\n" 
		   (List.map
		      (function (n,t) -> sprintf "%s %s" (cpp2str_typ t) (flatten_name n))
		      ps) in
	let body = cpp2str_stmt body in
	sprintf "%s\n%s(%s)\n%s\n" rt (flatten_name n) ps body
  | FunFwdD (n, ps, rt) ->
      let rt = cpp2str_typ rt in
      let ps = String.concat ",\n" 
		 (List.map
		    (function (n,t) -> 
		      match t with
			VoidT -> "void"
		      |	_ ->
			  sprintf "%s %s" (cpp2str_typ t) (flatten_name n))
		    ps) in
	sprintf "%s\n%s(%s);\n" rt (flatten_name n) ps 
  | ExternFunFwdD (lang, n, ps, rt) ->
      let rt = cpp2str_typ rt in
      let ps = String.concat ",\n" 
		 (List.map
		    (function (n,t) -> 
		      match t with
			VoidT ->
			  "void"
		      |	_ ->
			  sprintf "%s %s" (cpp2str_typ t) (flatten_name n))
		    ps) in
      if (lang = "C") then
	sprintf "extern \"C\" %s\n%s(%s);\n" rt (flatten_name n) ps 
      else
	sprintf "%s %s(%s);\n" rt (flatten_name n) ps 

  | ClassFwdD sn ->
      sprintf "class %s;" sn 

  | ClassD (cn, bases, ms) ->
      let bases = 
	if bases = [] then ""
	else sprintf " : %s" (String.concat ", " (map (fun b -> sprintf "public %s" b) bases)) in
      let ms = (String.concat "\n" (List.map (cpp2str_class_mem cn) ms)) in
      sprintf "struct %s%s {\n%s\n};\n" cn bases ms

  | MethodD (cn,mn, ps, rt, body) ->
	let rt = cpp2str_typ rt in
	let ps = List.map (function (n,t) -> sprintf "%s %s" (cpp2str_typ t) (flatten_name n)) ps in
	let ps = String.concat ",\n" ps in
	let body = cpp2str_stmt body in
 	  sprintf "%s %s::%s(%s)\n%s" rt cn (flatten_name mn) ps body

  | IncludeD fn ->
      sprintf "#include <%s>" fn

  | LocalD ds ->
      sprintf "namespace {\n%s\n}" (cpp2str ds)

  | ExternScopeD (lang, ds) ->
      sprintf "extern \"%s\" {\n%s\n}" lang
	(cpp2str ds)

and cpp2str_stmt (s : stmt) : string =
  match s with
    VarS (t, n, e) ->
      let ts = cpp2str_typ t in
      let es = cpp2str_exp e in
	sprintf "%s %s = %s;" ts (flatten_name n) es
  | ExprS (e) ->
      sprintf "%s;" (cpp2str_exp e)
  | ReturnS None ->
      sprintf "return;"
  | ReturnS (Some e) ->
      sprintf "return %s;" (cpp2str_exp e)
  | IfS (c, thn, els) ->
      sprintf "if (%s)\n%s\nelse\n%s"
	(cpp2str_exp c)
	(cpp2str_stmt thn)
	(cpp2str_stmt els)
  | WhileS (c, body) ->
      sprintf "while (%s)\n%s"
	(cpp2str_exp c)
	(cpp2str_stmt body)
  | SwitchS (c, s) -> 
      sprintf "switch (%s)\n%s" (cpp2str_exp c) (cpp2str_stmt s)

  | CaseS (e, s) -> sprintf "case %s:\n%s" (cpp2str_exp e) (cpp2str_stmt s)
  | DefaultS s -> sprintf "default:\n%s" (cpp2str_stmt s)

  | BreakS -> "break;"

  | CompoundS (ss) ->
      if ss = [] then
	sprintf "{ }"
      else
	sprintf "{\n%s\n}" 
	  (String.concat "\n" (List.map cpp2str_stmt ss))

  | PureS -> " = 0;"

and cpp2str_exp (e : exp) : string =
  (match e with
    IntE (n) -> sprintf "%d" n
  | FloatE (f) -> sprintf "%f" f
  | DoubleE (f) -> sprintf "%f" f
  | BoolE (b) -> sprintf "%b" b
  | StringE (s) -> 
      (* The cast is to ensure that the character array degrades to
	 a pointer, which can then be passed to an any. *)
      sprintf "(const char*)\"%s\"" (String.escaped s)
  | CharE (c) -> sprintf "\'%s\'" (Char.escaped c)
  | VarE (n) -> flatten_name n
  | ApplyE (PrimE (AssignP), [lhs; rhs]) ->
      sprintf "(%s) = %s" (cpp2str_exp lhs) (cpp2str_exp rhs)
  | MemE (s, f) ->
      sprintf "(%s).%s" (cpp2str_exp s) (flatten_name f)

  | ApplyE (PrimE (DeleteP), [e]) ->
      sprintf "(delete %s)" (cpp2str_exp e)
  | DestroyE (t, e) ->
      sprintf "(%s->~%s())" (cpp2str_exp e) (cpp2str_typ t)
  | ApplyE (PrimE (DerefP), [e]) ->
      sprintf "*(%s)" (cpp2str_exp e)
  | ApplyE (PrimE (EqP), [e1; e2]) ->
      sprintf "(%s) == (%s)" (cpp2str_exp e1) (cpp2str_exp e2)
  | ApplyE (PrimE (NeqP), [e1; e2]) ->
      sprintf "(%s) != (%s)" (cpp2str_exp e1) (cpp2str_exp e2)
  | ApplyE (PrimE (LessP), [e1; e2]) ->
      sprintf "(%s) < (%s)" (cpp2str_exp e1) (cpp2str_exp e2)
  | ApplyE (PrimE (LessEqP), [e1; e2]) ->
      sprintf "(%s) <= (%s)" (cpp2str_exp e1) (cpp2str_exp e2)
  | ApplyE (PrimE (GreaterP), [e1; e2]) ->
      sprintf "(%s) > (%s)" (cpp2str_exp e1) (cpp2str_exp e2)
  | ApplyE (PrimE (GreaterEqP), [e1; e2]) ->
      sprintf "(%s) >= (%s)" (cpp2str_exp e1) (cpp2str_exp e2)
  | ApplyE (PrimE (AddP), [e1; e2]) ->
      sprintf "(%s) + (%s)" (cpp2str_exp e1) (cpp2str_exp e2)
  | ApplyE (PrimE (SubP), [e1; e2]) ->
      sprintf "(%s) - (%s)" (cpp2str_exp e1) (cpp2str_exp e2)
  | ApplyE (PrimE (NegP), [e]) ->
      sprintf "-(%s)" (cpp2str_exp e)
  | ApplyE (PrimE (MultP), [e1; e2]) ->
      sprintf "(%s) * (%s)" (cpp2str_exp e1) (cpp2str_exp e2)
  | ApplyE (PrimE (DivP), [e1; e2]) ->
      sprintf "(%s) / (%s)" (cpp2str_exp e1) (cpp2str_exp e2)
  | ApplyE (PrimE (ModP), [e1; e2]) ->
      sprintf "(%s) %% (%s)" (cpp2str_exp e1) (cpp2str_exp e2)
  | ApplyE (PrimE (ShiftRightP), [e1; e2]) ->
      sprintf "(%s) >> (%s)" (cpp2str_exp e1) (cpp2str_exp e2)
  | ApplyE (PrimE (ShiftLeftP), [e1; e2]) ->
      sprintf "(%s) << (%s)" (cpp2str_exp e1) (cpp2str_exp e2)
  | ApplyE (PrimE (AndP), [e1; e2]) ->
      sprintf "(%s) && (%s)" (cpp2str_exp e1) (cpp2str_exp e2)
  | ApplyE (PrimE (OrP), [e1; e2]) ->
      sprintf "(%s) || (%s)" (cpp2str_exp e1) (cpp2str_exp e2)
  | ApplyE (PrimE (NotP), [e]) ->
      sprintf "!(%s)" (cpp2str_exp e)
  | ApplyE (PrimE (AddrP), [e]) ->
      sprintf "&(%s)" (cpp2str_exp e)
  | ApplyE (PrimE (SizeofP), [e]) ->
      sprintf "sizeof(%s)" (cpp2str_exp e)
  | SizeofE t ->
      sprintf "sizeof(%s)" (cpp2str_typ t)
  | ApplyE (PrimE (AtP), args) ->
      let a = List.nth args 0 and n = List.nth args 1 in
      sprintf "(%s)[%s]" (cpp2str_exp a) (cpp2str_exp n)
  | ApplyE (PrimE (IncP), args) ->
      let p = List.nth args 0 in
      sprintf "++(%s)" (cpp2str_exp p)
  | ApplyE (PrimE (DecP), args) ->
      let p = List.nth args 0 in
      sprintf "--(%s)" (cpp2str_exp p)

  | CastE (t, e) ->
      sprintf "(%s)(%s)" (cpp2str_typ t) (cpp2str_exp e)
  | AnyCastE (t, e) ->
      sprintf "__g::any_cast(__g::to_type<%s>(), %s)" (cpp2str_typ t) (cpp2str_exp e)

  | ApplyE (f, args) ->
      sprintf "(%s)(%s)" (cpp2str_exp f)
	(String.concat ",\n" (List.map cpp2str_exp args))
  | IfE (c, els, thn) ->
      sprintf "((%s) ? (%s) : (%s))" (cpp2str_exp c) (cpp2str_exp els) (cpp2str_exp thn)

  | ClassE (a, cn, k, args) ->
      let a = match a with
	  Stack -> ""
	| Heap -> "new "
	| GCHeap -> "new " in
      let args = List.map cpp2str_exp args in
      let args = 
	if k >= 0 then args@[sprintf "__make_int<%d>()" k] 
	else args in
      let args = String.concat "," args in
      sprintf "%s%s(%s)" a cn args

  | PlacementClassE (p, cn, k, args) ->
      let p = cpp2str_exp p in
      let args = List.map cpp2str_exp args in
      let args = 
	if k >= 0 then args@[sprintf "__make_int<%d>()" k] 
	else args in
      let args = String.concat "," args in
      sprintf "new (%s) %s(%s)" p cn args

  | NullE -> "0"
  | PrimE (p) -> sprintf "primitive %s" (prim2str p)

  | NewE (a, t, args) ->
      (match a with
	   Stack ->
	     (match (t,args) with
	       (PtrT _, []) ->
		 sprintf "((%s)0)" (cpp2str_typ t)
	     | (PtrT _, [e]) ->
		 sprintf "((%s)%s)" (cpp2str_typ t) (cpp2str_exp e)
	     | _ ->
		 sprintf "%s(%s)"
		   (cpp2str_typ t)  
		   (String.concat ", "
		      (List.map cpp2str_exp args)))
	 | _ ->
	     sprintf "new %s%s(%s)" 
	       (cpp2str_alloc a)
	       (cpp2str_typ t)  
	       (String.concat ", "
		  (List.map cpp2str_exp args)))

  | PlacementNewE (p, t, args) -> 
      sprintf "new (%s) %s(%s)" 
	(cpp2str_exp p)
	(cpp2str_typ t)  
	(String.concat ", " (List.map cpp2str_exp args))

  | NewArrayE (a, t, e) ->
      sprintf "new %s%s[%s]" (cpp2str_alloc a) (cpp2str_typ t) (cpp2str_exp e) 

  | ScopedE ns ->
      String.concat "::" ns

  | FunE (ps, rt, inits, body) ->
      cpp2str_decl (FunD ("anon", ps, rt, body))
      (*error UNKNOWN "cpp2str_exp: FunE should be gone"*)

  | SeqE es ->
      String.concat ", " (map cpp2str_exp es)
  )

and cpp2str_typ t =
  match t with
    AnyT -> "__g::any"
  | AnyRefT -> "__g::any_reference"
  | AnyConstRefT -> "__g::any_const_reference"
  | AnyPtrRefT -> "__g::any_ptr_ref"
  | AnyConstPtrRefT -> "__g::any_const_ptr_ref"
  | AnyPtrConstRefT -> "__g::any_ptr_const_ref"
  | AnyConstPtrConstRefT -> "__g::any_const_ptr_const_ref"
  | AnyPtrT -> "__g::any_pointer"
  | AnyConstPtrT -> "__g::any_const_pointer"
  | RefT t ->
      sprintf "%s&" (cpp2str_typ t)
  | PtrT t -> sprintf "%s*" (cpp2str_typ t)
  | ConstT t ->
      sprintf "%s const" (cpp2str_typ t)
  | ClassT n -> n
  | UnionT ms ->
      sprintf "union {\n%s\n}"
	(String.concat "\n" 
	   (List.map (fun (n,t) -> 
	     sprintf "%s %s;" (cpp2str_typ t) n) ms))
  | IntT -> "int"
  | ShortT -> "short"
  | LongT -> "long"
  | LongLongT -> "long long"
  | FloatT -> "float"
  | DoubleT -> "double"
  | LongDoubleT -> "long double"
  | BoolT -> "bool"
  | StringT -> "CORD"
  | CharT -> "char"
  | WCharT -> "wchar_t"
  | VoidT -> "void"
  | FunT (ps,rt) ->
      sprintf "boost::function<%s (%s)>"
	(cpp2str_typ rt)
	(String.concat ", " (List.map cpp2str_typ ps))
  | NullT -> "void*"
  | UnsignedT t -> sprintf "unsigned %s" (cpp2str_typ t)
  | SignedT t -> sprintf "signed %s" (cpp2str_typ t)
  | ElipsesT -> "..."


and basic_typ t =
  (match t with
    PtrT _ 
  | IntT
  | ShortT
  | LongT 
  | LongLongT
  | FloatT 
  | DoubleT 
  | LongDoubleT
  | BoolT
  | CharT
  | WCharT
  | UnsignedT _
  | SignedT _
      -> true
  | _ -> false)