civicaml/stringify.ml

open Ast

let tab = "    "

(* string -> string *)
let indent = Str.global_replace (Str.regexp "^\\(.\\)") (tab ^ "\\1")

(* 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"
    | ArrayDec (t, dims)
    | ArrayDef (t, dims)   -> (type2str t) ^ "[" ^ (concat ", " dims) ^ "]"
    | ArraySpec (t, ndims) -> (type2str t) ^ "[" ^ string_of_int ndims ^ "]"

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
    | Dim (name, _) -> 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, value, _) ->
        name ^ " = " ^ (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
            | IntConst (1, _) -> ""
            | value -> ", " ^ str value
        in
        let range = str start ^ ", " ^ str stop ^ step in
        "for (int " ^ counter ^ " = " ^ range ^ ") " ^ str body
    | Allocate (name, dims, _) ->
        name ^ " = __allocate(" ^ concat ", " dims ^ ");"
    | Block body -> "{\n" ^ indent (concat "\n" body) ^ "\n}"

    (* Expressions *)
    | BoolConst (b, _) -> string_of_bool b
    | IntConst (i, _) -> string_of_int i
    | FloatConst (f, _) -> string_of_float f
    | ArrayConst (dims, _) -> "[" ^ concat ", " dims ^ "]"
    | ArrayScalar (value, _) -> str value
    | Var (v, _) -> v
    | Deref (name, dims, _) -> name ^ (str (ArrayConst (dims, noloc)))
    | Monop (op, opnd, _) -> op2str op ^ str opnd
    | Binop (op, left, right, _) ->
        "(" ^ str left ^ " " ^ op2str op ^ " " ^ str right ^ ")"
    | Cond (cond, t, f, _) -> (str cond) ^ " ? " ^ str t ^ " : " ^ str f
    | TypeCast (ctype, value, _) -> "(" ^ type2str ctype ^ ")" ^ str value
    | FunCall (name, args, _) -> name ^ "(" ^ (concat ", " args) ^ ")"

    (* FIXME: these should be printed when verbose=3
    | Arg node -> "<arg>(" ^ str node ^ ")"
    | Type (node, ctype) -> str node ^ ":" ^ type2str ctype
    | VarUse (value, _, _)
    | FunUse (value, _, _) -> "<use>(" ^ str value ^ ")"
    *)

    | Arg node
    | Type (node, _)
    | FunUse (node, _, _)
    | VarLet (node, _, _)
    | VarUse (node, _, _) -> str node

    | _ -> raise InvalidNode

(* ctype list -> string *)
let rec types2str = function
    | [] -> ""
    | [ctype] -> type2str ctype
    | ctype :: tail -> type2str ctype ^ " or " ^ (types2str tail)