Source

blaise / prettyprint.ml

let rec format_expr ppf =
  let rec format_args ppf = function
    | [] -> Format.fprintf ppf ""
    | [x] -> Format.fprintf ppf "%a" format_expr x
    | x :: xs -> Format.fprintf ppf "%a,@ %a" format_expr x format_args xs
  in function
    | Ast.Int(n) -> Format.fprintf ppf "%d" n
    | Ast.Var(v) -> Format.fprintf ppf "%s" v
    | Ast.BinOp(e1,op,e2) ->
        Format.fprintf ppf "%a@ %s@ %a" format_expr e1 op format_expr e2
    | Ast.UniOp(op,e) ->
        Format.fprintf ppf "%s%a" op format_expr e
    | Ast.Call(name,args) ->
        Format.fprintf ppf "%s(@[%a@])" name format_args args

let rec format_statement ppf = function
  | Ast.Assign(v,e) -> Format.fprintf ppf "%s@ =@ %a;" v format_expr e
  | Ast.Expr(e) -> Format.fprintf ppf "%a;" format_expr e
  | Ast.If(e,thenl,elsel) ->
      Format.fprintf ppf
        "if@ (%a)@\n@[{@[<3>@\n%a@]@\n}@]@\nelse@\n@[{@[<3>@\n%a@]@\n}@]"
        format_expr e format_statement_list thenl
        format_statement_list elsel
  | Ast.While(e, stl) ->
      Format.fprintf ppf "while@ (%a)@\n@[{@[<3>@\n%a@]@\n}@]" format_expr e
        format_statement_list stl
  | Ast.Return(e) -> Format.fprintf ppf "return %a;" format_expr e

and format_statement_list ppf = function
  | [] -> Format.fprintf ppf ""
  | [x] -> Format.fprintf ppf "%a" format_statement x
  | x :: xs -> Format.fprintf ppf "%a@\n%a" format_statement x
                 format_statement_list xs

let rec format_list ppf = function
    | [] -> Format.fprintf ppf ""
    | [x] -> Format.fprintf ppf "%s" x
    | x :: xs -> Format.fprintf ppf "%s, %a" x format_list xs

let format_vars ppf = function
  | [] -> Format.fprintf ppf ""
  | l -> Format.fprintf ppf "vars@ @[%a@];@\n" format_list l

let format_function ppf fdecl =
  Format.fprintf ppf "%s(%a)@\n@[{@[<3>@\n%a%a@]@\n}@]"
    fdecl.Ast.fname
    format_list fdecl.Ast.fparams
    format_vars fdecl.Ast.fvars
    format_statement_list fdecl.Ast.fbody

let rec format_function_list ppf = function
  | [] -> Format.fprintf ppf ""
  | [x] -> Format.fprintf ppf "%a@\n@\n" format_function x
  | x :: xs -> Format.fprintf ppf "%a@\n%a"
                 format_function x
                 format_function_list xs

let format_main ppf main =
  Format.fprintf ppf "main ()@\n@[{@[<3>@\n%a%a@]@\n}@]"
    format_vars main.Ast.mainvars
    format_statement_list main.Ast.mainbody

let f ast =
  Format.fprintf Format.std_formatter "%a%a@."
    format_function_list ast.Ast.func
    format_main ast.Ast.main