civicaml/phases/print.ml

open Types
open Util
open Stringify

let tab = "    "

let rec repeat s n = if n < 1 then "" else s ^ (repeat s (n - 1))
let pad width s = s ^ (repeat " " (String.length s - width))
let paddall width = List.map (pad width)

let ctype2str = Stringify.type2str
let type2str = function
    | Array (t, dims) -> ctype2str t ^ repeat "," (List.length dims - 1)
    | t -> ctype2str t

let prefix node = match typeof node with
    | Bool _  -> "b"
    | Int _   -> "i"
    | Float _ -> "f"
    | Array _ -> "a"
    | _ -> raise InvalidNode

let instr2str = function
    (* Global / directives *)
    | Comment comment ->
        "# " ^ comment
    | Label name ->
        name ^ ":"
    | Export (name, ret_type, arg_types, label) ->
        let types = List.map type2str (ret_type :: arg_types) in
        ".export \"" ^ name ^ "\" " ^ (String.concat " " types) ^ " " ^ label
    | Import (name, ret_type, arg_types) ->
        let types = List.map type2str (ret_type :: arg_types) in
        ".import \"" ^ name ^ "\" " ^ (String.concat " " types)
    | Const node ->
        ".const  " ^ (node2str node)
    | Global ctype ->
        ".global " ^ (type2str ctype)

    (* Load constant *)
    | LoadConst (ctype, index) ->
        tab ^ type2str ctype ^ "loadc " ^ string_of_int index
    | LoadImm (BoolConst (b, _)) ->
        tab ^ "bloadc_" ^ (if b then "t" else "f")
    | LoadImm (IntConst (i, _)) when i < 0 ->
        tab ^ "iloadc_m" ^ string_of_int (-i)
    | LoadImm (IntConst (i, _)) ->
        tab ^ "iloadc_" ^ string_of_int i
    | LoadImm (FloatConst (i, _)) ->
        tab ^ "floadc_" ^ string_of_int (int_of_float i)

    | _ -> tab ^ "<unknown instruction>"

let rec print_assembly oc instrs =
    let output_line line =
        output_string oc line;
        output_char oc '\n';
    in
    let endbuf = ref [] in
    let rec trav = function
        | [] -> ()
        | hd :: tl ->
            let line = instr2str hd in
            (if String.length line > 0 && line.[0] = '.' then
                endbuf := line :: !endbuf
            else
                output_line line
            );
            trav tl
    in
    trav instrs;
    List.iter output_line (List.rev !endbuf)
    (*
    let hasdot ins = if String.length ins > 0 && ins.[0] = '.' then 1 else 0 in
    let cmp a b = compare (hasdot a) (hasdot b) in
    List.sort cmp (trav instrs)
    *)

let phase = function
    | Types node as input ->
        if args.verbose >= 2 then (
            prerr_endline "--------------------------------------------------";
            prerr_endline (node2str node);
            prerr_endline "--------------------------------------------------"
        );
        input

    | FileContent (display_name, content) as input ->
        if args.verbose >= 2 then (
            prerr_endline "--------------------------------------------------";
            prerr_endline (display_name ^ ":\n");
            prerr_endline content;
            prerr_endline "--------------------------------------------------"
        );
        input

    | Assembly instrs as input ->
        (match args.outfile with
        | Some filename ->
            let oc = open_out filename in
            print_assembly oc instrs;
            close_out oc
        | None ->
            if args.verbose >= 2 then
                prerr_endline "--------------------------------------------------";

            print_assembly stdout instrs;

            if args.verbose >= 2 then
                prerr_endline "--------------------------------------------------"
        );
        input

    | _ -> raise (InvalidInput "print")