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 ^ "" 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")