open Ast
open Sast
open Semantic
open Printast
open Printf
open Exception

let xout = open_out "sast.txt";;

let rec str_indent layer =
if layer = 1 then 
    "  - " ^ str_indent (layer-1)
else if layer > 1 then
    "  " ^ str_indent (layer-1)
else
    "";;

let rec xstr_type = function
| Wild_Card(i) -> sprintf "W<%d>" i
| Int -> "mpz"
| Bits(i) -> sprintf "bs<%d>" i
| String -> "str"
| Vector(t, l) ->
    let dim_part = List.fold_left (fun s i -> sprintf "%s[%i]" s i) "" l in
    sprintf "%s%s" (xstr_type t) dim_part
| Fun(fc, t, t_l) ->
    let fcs = begin match fc with
    | Fix -> "fix"
    | Len_Flex -> "flex"
    | Indef -> "indefun" end in
    let in_t_s = begin match t_l with
    | [] -> "none"
    | hd::tl -> List.fold_left
        (fun s t -> s ^ "*" ^ (xstr_type t)) (xstr_type hd) tl end in
    sprintf "%s(%s -> %s)" fcs in_t_s (xstr_type t)
| Special(s) -> s

let rec str_xexpr indent xexpr =
str_indent indent ^
match xexpr with
| Xint_Lit(s) -> sprintf "[mpz] %s" s
| Xbin_Lit(s) -> sprintf "[mpz-b] %s" s
| Xhex_Lit(s) -> sprintf "[mpz-x] %s" s
| Xbit_Binary_Lit(s, i) -> sprintf "[bs<%d>] %s" i s
| Xbit_Hex_Lit(s, i) -> sprintf "[bs-x<%d>] %s" i s
| Xstring_Lit(s) -> sprintf "[str]%s" s
| Xvector_Lit(xexpr_l) ->
    let s_type = xstr_type (Semantic.get_type (Xvector_Lit(xexpr_l))) in
    let sexpr_l = List.map (fun xe -> str_xexpr 0 xe) xexpr_l in
    let content = List.fold_left (fun s1 s2 -> s1 ^ ", " ^ s2)
        (List.hd sexpr_l) (List.tl sexpr_l) in
    sprintf "%s{%s}" s_type content
| Xid(s, t) -> sprintf "[ID-%s] %s" (xstr_type t) s
| Xidd(s, xexpr_l, t) -> sprintf "[ID-%s] %s%s" (xstr_type t) s
    (List.fold_left (fun s xe -> sprintf "%s[%s]" s (str_xexpr 0 xe)) "" xexpr_l)
| Xvec_Dimension(i) -> sprintf "[index] %d" i
| Xfuncall(fn, xe_l, t, _) ->
    List.fold_left (fun s1 s2 -> s1 ^ s2)
    (sprintf "[fun-%s] %s" (xstr_type t) fn)
    (List.map (fun xe -> sprintf "\n%s" (str_xexpr (indent+1) xe)) xe_l)
| Xmake_Vector(t, xexpr) ->
    sprintf "[%s] make-vector\n%s" (xstr_type t) (str_xexpr (indent + 1) xexpr)
| Xlet(l_l, xe) ->
    sprintf "[%s] let <%s>\n%s"
        (xstr_type (Semantic.get_type xe))
        (List.fold_left
            (fun s idt -> sprintf "%s, [%s] %s" s (xstr_type idt.t) idt.id)
            (let idt = fst (List.hd l_l) in
            sprintf "[%s] %s" (xstr_type idt.t) idt.id)
            (fst (List.split (List.tl l_l))))
        (str_xexpr (indent + 1) xe)
| Xlambda(idt_l, xe, i) ->
    sprintf "[lambda] <%s -> %s>\n%s" 
        "abc"
        (xstr_type (Semantic.get_type xe))
        (str_xexpr (indent + 1) xe)

let str_xdefvar xdefv =
    sprintf "BIND [%s] %s = %s" (xstr_type xdefv.xvname.t) xdefv.xvname.id (str_xexpr 0 xdefv.xvbody)

let str_xdefun xdefun =
    let in_t_s = begin match (List.map (fun idt -> idt.t) xdefun.xfargu) with
    | [] -> "none"
    | hd::tl -> List.fold_left
        (fun s t -> s ^ "*" ^ (xstr_type t)) (xstr_type hd) tl end in
    sprintf "BIND [%s -> %s] %s =\n%s"
        in_t_s
        (xstr_type xdefun.xfname.t)
        xdefun.xfname.id
        (str_xexpr 1 xdefun.xfbody)

let print_xclip = function
| Xexpr(xexpr, _) -> fprintf xout "%s\n" (str_xexpr 0 xexpr)
| Xdefvar(xdefvar) -> fprintf xout "%s\n" (str_xdefvar xdefvar)
| Xdefun(xdefun) -> fprintf xout "%s\n" (str_xdefun xdefun);;

let print_sast p =
    fprintf xout"===================================== sast ";
    fprintf xout"=====================================\n";
    List.iter (fun xc -> print_xclip xc) p;;