civicaml/stringify.ml

open Ast

let tab = "    "

(* int -> string list -> string list *)
let indent (lines : string list) =
    let prepend_tab line = tab ^ line in
    List.map prepend_tab lines

(* monop -> string *)
let monop2str = function
    | Neg -> "-"
    | Not -> "!"

(* binop -> string *)
let binop2str = function
    | 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"
    | ArrayDec (t, dims) -> (type2str t) ^ "[" ^ (String.concat ", " dims) ^ "]"
    | ArrayDef (t, dims) -> (type2str t) ^ "[" ^ (String.concat ", " (List.map node2str dims)) ^ "]"

(* decl -> string list *)
and node2lines node =
    let all_str = List.map node2str in
    let all_lines = List.map node2lines in
    match node with
    (* Decls *)
    | FunDec (ret_type, name, params) ->
        let params = String.concat ", " (all_str 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 = String.concat ", " (all_str params) in
        let header = (type2str ret_type) ^ " " ^ name ^ "(" ^ params ^ ")" in
        let body = indent (List.concat (all_lines body)) in
        [export ^ header ^ " {"] @
            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 -> " = " ^ (node2str 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 ^ " = " ^ (node2str init) ^ ";"]
    | Assign (name, value) ->
        [name ^ " = " ^ (node2str value) ^ ";"]
    | Expr expr ->
        [node2str expr ^ ";"]
    | Return value ->
        ["return " ^ (node2str value) ^ ";"]
    | If (cond, body) ->
        let body = indent (List.concat (all_lines body)) in
        ["if (" ^ (node2str cond) ^ ") {"] @
            body @
        ["}"]
    | IfElse (cond, true_body, false_body) ->
        let true_body = indent (List.concat (all_lines true_body)) in
        let false_body = indent (List.concat (all_lines false_body)) in
        ["if (" ^ (node2str cond) ^ ") {"] @
            true_body @
        ["} else {"] @
            false_body @
        ["}"]
    | While (cond, body) ->
        let body = indent (List.concat (all_lines body)) in
        ["while (" ^ (node2str cond) ^ ") {"] @
            body @
        ["}"]
    | DoWhile (cond, body) ->
        let body = indent (List.concat (all_lines body)) in
        ["do {"] @
            body @
        ["} while (" ^ (node2str cond) ^ ");"]
    | For (counter, start, stop, step, body) ->
        let step = match step with
            | IntConst 1 -> ""
            | value -> ", " ^ (node2str value)
        in
        let range = (node2str start) ^ ", " ^ (node2str stop) ^ step in
        let body = indent (List.concat (all_lines body)) in
        ["for (int " ^ counter ^ " = " ^ range ^ ") {"] @
            body @
        ["}"]

    (* Catch-all, whould never happen *)
    | _ -> failwith "invalid node"

(* node -> string *)
and node2str = function
    (* Global *)
    | Program decls ->
        let decl2str decl = String.concat "\n" (node2lines decl) in
        String.concat "\n\n" (List.map decl2str decls)
    | Param (param_type, name) -> (type2str param_type) ^ " " ^ name

    (* Expressions *)
    | BoolConst b -> string_of_bool b
    | IntConst i -> string_of_int i
    | FloatConst f -> string_of_float f
    | ArrayConst dims -> "[" ^ (String.concat ", " (List.map node2str dims)) ^ "]"
    | Var v -> v
    | Deref (name, dims) -> name ^ (node2str (ArrayConst dims))
    | Monop (op, opnd) -> monop2str op ^ node2str opnd
    | Binop (op, left, right) ->
        "(" ^ node2str left ^ binop2str op ^ node2str right ^ ")"
    | Cond (cond, t, f) ->
        (node2str cond) ^ " ? " ^ (node2str t) ^ " : " ^ (node2str f)
    | TypeCast (ctype, value) ->
        "(" ^ (type2str ctype) ^ ")" ^ (node2str value)
    | FunCall (name, args) ->
        name ^ "(" ^ (String.concat ", " (List.map node2str args)) ^ ")"

    | node -> String.concat "\n" (node2lines node)