civicaml/stringify.ml

open Types

let tab = "    "
let indent = Str.global_replace (Str.regexp "^\\(.\\)") (tab ^ "\\1")

(* const -> string *)
let const2str = function
  | BoolVal  b -> string_of_bool b
  | IntVal   i -> Int32.to_string i
  | FloatVal f ->
    (* Add a trailing zero to a float stringification *)
    match string_of_float f with
    | s when s.[String.length s - 1] = '.' -> s ^ "0"
    | s -> s

(* Copied from util.ml to avoid circular dependency *)
let nameof = function
  | GlobalDec (_, name, _)
  | GlobalDef (_, _, name, _, _)
  | FunDec (_, name, _, _)
  | FunDef (_, _, name, _, _, _)
  | VarDec (_, name, _, _)
  | Param (_, name, _)
  | Dim (name, _) -> name
  | _ -> raise InvalidNode

(* operator -> string *)
let op2str = function
  | Neg -> "-"
  | Not -> "!"
  | Add -> "+"
  | Sub -> "-"
  | Mul -> "*"
  | Div -> "/"
  | Mod -> "%"
  | Eq  -> "=="
  | Ne  -> "!="
  | Lt  -> "<"
  | Le  -> "<="
  | Gt  -> ">"
  | Ge  -> ">="
  | And -> "&&"
  | Or  -> "||"

(* ctype -> string *)
let rec type2str = function
  | Void  -> "void"
  | Bool  -> "bool"
  | Int   -> "int"
  | Float -> "float"
  | ArrayDims (t, dims) -> type2str t ^ "[" ^ concat ", " dims ^ "]"
  | Array t             -> type2str t ^ "[]"
  | Unknown -> "unknown"

and concat sep nodes = String.concat sep (List.map node2str nodes)

(* node -> string *)
and node2str node =
  let str = node2str in
  match node with

  (* Global *)
  | Program (decls, _) ->
    concat "\n\n" decls
  | Param (param_type, name, _) ->
    type2str param_type ^ " " ^ name
  | FunDec (ret_type, name, params, _) ->
    let params = concat ", " params in
    "extern " ^ type2str ret_type ^ " " ^ name ^ "(" ^ params ^ ");"
  | FunDef (export, ret_type, name, params, body, _) ->
    let export = if export then "export " else "" in
    let params = "(" ^ concat ", " params ^ ")" in
    export ^ type2str ret_type ^ " " ^ name ^ params ^ " " ^ str body
  | GlobalDec (var_type, name, _) ->
    "extern " ^ type2str var_type ^ " " ^ name ^ ";"
  | GlobalDef (export, ret_type, name, init, _) ->
    let export = if export then "export " else "" in
    let init = match init with
    | Some value -> " = " ^ str value
    | None -> ""
    in
    export ^ (type2str ret_type) ^ " " ^ name ^ init ^ ";"

  (* Statements *)
  | VarDec (var_type, name, None, _) ->
    type2str var_type ^ " " ^ name ^ ";"
  | VarDec (var_type, name, Some init, _) ->
    type2str var_type ^ " " ^ name ^ " = " ^ str init ^ ";"
  | Assign (name, None, value, _) ->
    name ^ " = " ^ str value ^ ";"
  | Assign (name, Some dims, value, _) ->
    name ^ "[" ^ concat ", " dims ^ "] = " ^ str value ^ ";"
  | Expr expr ->
    str expr ^ ";"
  | Return (value, _) ->
    "return " ^ (str value) ^ ";"
  | If (cond, body, _) ->
    "if (" ^ str cond ^ ") " ^ str body
  | IfElse (cond, true_body, false_body, _) ->
    "if (" ^ str cond ^ ") " ^ str true_body ^ " else " ^ str false_body
  | While (cond, body, _) ->
    "while (" ^ str cond ^ ") " ^ str body
  | DoWhile (cond, body, _) ->
    "do " ^ str body ^ " while (" ^ str cond ^ ");"
  | For (counter, start, stop, step, body, _) ->
    let step = match step with
      | Const (IntVal 1l, _) -> ""
      | value -> ", " ^ str value
    in
    let range = str start ^ ", " ^ str stop ^ step in
    "for (int " ^ counter ^ " = " ^ range ^ ") " ^ str body
  | Allocate (dec, dims, _) ->
    nameof dec ^ " = __allocate(" ^ concat ", " dims ^ ");"
  | Block body ->
    let rec append pre = function
      | []       -> pre
      | [last]   -> pre ^ last
      | "" :: tl -> append pre tl
      | hd :: tl -> append (pre ^ hd ^ "\n") tl
    in
    "{\n" ^ indent (append "" (List.map str body)) ^ "\n}"

  (* Expressions *)
  | Const (value, _) ->
    const2str value
  | ArrayConst (dims, _) ->
    "[" ^ concat ", " dims ^ "]"
  | Var (name, None, _) -> name
  | Var (name, Some dims, _) ->
    name ^ "[" ^ concat ", " dims ^ "]"
  | Monop (op, opnd, _) ->
    op2str op ^ str opnd
  | Binop (op, left, right, _) ->
    "(" ^ str left ^ " " ^ op2str op ^ " " ^ str right ^ ")"
  | TypeCast (ctype, value, _) ->
    "(" ^ type2str ctype ^ ")" ^ str value
  | FunCall (name, args, _) ->
    name ^ "(" ^ concat ", " args ^ ")"
  | Cond (cond, t, f, _) -> "(" ^ str cond ^ " ? " ^ str t ^ " : " ^ str f ^ ")"

  (* Annotation nodes print more information at higher verbosity, for
   * debugging purposes *)
  | VarLet (dec, dims, value, _) when Globals.args.verbose >= 3 ->
    "<let:" ^ node2str (Assign (nameof dec, dims, value, [])) ^ ">"
  | VarUse (dec, dims, _)        when Globals.args.verbose >= 3 ->
    "<use:" ^ node2str (Var (nameof dec, dims, [])) ^ ">"
  | FunUse (dec, params, _)      when Globals.args.verbose >= 3 ->
    "<use:" ^ node2str (FunCall (nameof dec, params, [])) ^ ">"
  | Dim (name, _)                when Globals.args.verbose >= 3 ->
    "<dim:" ^ name ^ ">"
  | Arg node                     when Globals.args.verbose >= 3 ->
    "<arg:" ^ str node ^ ">"
  | VarDecs nodes                when Globals.args.verbose >= 3 ->
    String.concat "\n" ("// vardecs" :: List.map str nodes)
  | LocalFuns nodes              when Globals.args.verbose >= 3 ->
    String.concat "\n" ("// localfuns" :: List.map str nodes)

  | VarLet (dec, dims, value, _) ->
    node2str (Assign (nameof dec, dims, value, []))
  | VarUse (dec, dims, _) ->
    node2str (Var (nameof dec, dims, []))
  | FunUse (dec, args, _) ->
    node2str (FunCall (nameof dec, args, []))
  | Dim (name, _) -> name
  | ArrayInit (node, _)
  | Arg node -> str node

  | VarDecs nodes
  | LocalFuns nodes -> concat "\n" nodes

  | DummyNode -> "<dummy>"