source: Deliverables/Dissemination/final-review/wp5/Pics/summul_result_erased_mips.ml @ 3282

open Mlpost;;
open Box;;
open Arrow;;
open Path;;
open Command;;
open Num;;
open Dash;;
open Color;;
open Pen;;
open Point;;
open Picture;;


let box = Box.box ~stroke:None ~dx:zero ~dy:zero
let path = Box.path ~stroke:None ~dx:zero ~dy:zero
let pic = Box.pic ~stroke:None ~dx:zero ~dy:zero

(* Helpers *)

let string_of_list sep f =
  let rec aux = function
    | [] -> ""
    | [e] -> f e
    | e :: l -> (f e) ^ sep ^ (aux l)
  in
  aux

let mapi f =
  let rec aux i = function
    | [] -> []
    | e :: l -> (f i e) :: (aux (i+1) l)
  in
  aux 0

let cell = Box.rect ~stroke:None


(* Text *)

let color_text color text = "\\textcolor{" ^ color ^ "}{" ^ text ^ "}"
let color_bftext color text = "\\textcolor{" ^ color ^ "}{\\bf " ^ text ^ "}"
let texttt text = "\\texttt{" ^ text ^ "}"

let line lexs =
  Box.tex (texttt (string_of_list " " (fun s -> s) lexs))

let code lines =
  let f (b_prev, b_res) b_line =
    let b_line = Box.place `Southwest ~pos:`Northwest b_prev b_line in
    (b_line, b_res @ [b_line])
  in
  let (_, b_res) = List.fold_left f (Box.empty (), []) (List.map line lines) in
  Box.group b_res

let typ = color_text "black"
let op = color_text "black"
let keyword = color_bftext "black"
let comment s = [color_text "red" s]
let label lab = [color_bftext "black" (lab ^ ":")]
(* let emit_label lab = [keyword "emit"; color_text "magenta" lab] *)
let emit_label lab = [ "\\textcolor{lightgray}{\\textbf{emit} {" ^ lab ^ "}}" ]
let reg i = color_text "black" ("\\%" ^ (string_of_int i))
let hreg s = color_text "black" ("\\$" ^ s)
let string_id s = color_text "black" ("\"" ^ s ^ "\"")
let special = op

let kif = keyword "if"
let kreturn = keyword "return"
let kcall f = [special "call" ; string_id f]

let typ_int = typ "int"

let assigns = op "$\\leftarrow$"
let line_assigns x y = [x ; assigns ; y]
let nop = [special "nop"]
let newframe = [special "newframe"]
let delframe = [special "delframe"]

let preamble =
  code [comment "\\# begin preamble" ; [".data"] ; label "globals" ;
        ["\\ \\ .space" ; "0"] ; [".text"] ; label "main" ;
        line_assigns (hreg "gp") (keyword "globals") ;
        [special "j" ; keyword "main14"] ; comment "\\# end preamble"]

let summul =
  code [
(*        comment "\\# begin summul" ; label "summul34" ; *)
        emit_label "\\_cost2" ;
        line_assigns (hreg "v0") "1" ; line_assigns (hreg "a1") "1" ;
        label "summul10" ; line_assigns (hreg "a3") "0" ;
        [hreg "a2" ; assigns ; hreg "a0" ; "$\\ge$" ; hreg "a1"] ;
        [hreg "a2" ; assigns ; hreg "a2" ; "==" ; hreg "zero"] ;
        [hreg "a2" ; op "==" ; hreg "a3" ; "$\\Rightarrow$" ;
         keyword "summul6"] ; 
        emit_label "\\_cost4" ; [special "jr" ; hreg "ra"] ;
        label "summul6" ;
        emit_label "\\_cost3" ;
        [hreg "a2" ; assigns ; hreg "v0" ; "$\\times$" ; hreg "a0"] ;
        [hreg "v0" ; assigns ; hreg "v0" ; "+" ; hreg "a2"] ;
        line_assigns (hreg "a2") "1" ;
        [hreg "a0" ; assigns ; hreg "a0" ; "$-$" ; hreg "a2"] ;
        [special "j" ; keyword "summul10"] ; 
        (* comment "\\# end summul" *)]

let main =
  code [comment "\\# begin main" ; label "main14" ;
        [hreg "sp" ; assigns ; hreg "sp" ; "$-$" ; "4"] ;
        line_assigns ((hreg "sp") ^ "[0]") (hreg "ra") ;
        label "\\_cost1" ;
        line_assigns (hreg "a0") "5" ;
        [special "jal" ; keyword "summul34"] ;
        line_assigns (hreg "ra") ((hreg "sp") ^ "[0]") ;
        [hreg "sp" ; assigns ; hreg "sp" ; "$+$" ; "4"] ;
        [special "jr" ; hreg "ra"] ;
        comment "\\# end main"]


(* Place Text *)


(* Strokes and arrows *)


(* Main *)

let summul_result_mips = Box.hbox ~padding:(cm 1.5) ~pos:`Top
  [summul ]

let summul_result_mips = Box.draw summul_result_mips

let _ = Metapost.emit "summul_result_erased_mips" summul_result_mips