diff options
Diffstat (limited to 'bytecomp/printlambda.ml')
| -rw-r--r-- | bytecomp/printlambda.ml | 195 |
1 files changed, 0 insertions, 195 deletions
diff --git a/bytecomp/printlambda.ml b/bytecomp/printlambda.ml deleted file mode 100644 index 001209d78a..0000000000 --- a/bytecomp/printlambda.ml +++ /dev/null @@ -1,195 +0,0 @@ -open Format -open Asttypes -open Lambda - - -let rec structured_constant = function - Const_base(Const_int n) -> print_int n - | Const_base(Const_char c) -> - print_string "'"; print_string(Char.escaped c); print_string "'" - | Const_base(Const_string s) -> - print_string "\""; print_string(String.escaped s); print_string "\"" - | Const_base(Const_float s) -> - print_string s - | Const_block(tag, []) -> - print_string "["; print_int tag; print_string "]" - | Const_block(tag, sc1::scl) -> - open_hovbox 1; - print_string "["; print_int tag; print_string ":"; - print_space(); - open_hovbox 0; - structured_constant sc1; - List.iter (fun sc -> print_space(); structured_constant sc) scl; - close_box(); - print_string "]"; - close_box() - -let primitive = function - Pidentity -> print_string "id" - | Pgetglobal id -> print_string "global "; Ident.print id - | Psetglobal id -> print_string "setglobal "; Ident.print id - | Pmakeblock sz -> print_string "makeblock "; print_int sz - | Ptagof -> print_string "tag" - | Pfield n -> print_string "field "; print_int n - | Psetfield n -> print_string "setfield "; print_int n - | Pccall(name, arity) -> print_string name - | Pupdate -> print_string "update" - | Praise -> print_string "raise" - | Psequand -> print_string "&&" - | Psequor -> print_string "||" - | Pnot -> print_string "not" - | Pnegint -> print_string "~" - | Paddint -> print_string "+" - | Psubint -> print_string "-" - | Pmulint -> print_string "*" - | Pdivint -> print_string "/" - | Pmodint -> print_string "mod" - | Pandint -> print_string "and" - | Porint -> print_string "or" - | Pxorint -> print_string "xor" - | Plslint -> print_string "lsl" - | Plsrint -> print_string "lsr" - | Pasrint -> print_string "asr" - | Pcomp(Ceq) -> print_string "==" - | Pcomp(Cneq) -> print_string "!=" - | Pcomp(Clt) -> print_string "<" - | Pcomp(Cle) -> print_string "<=" - | Pcomp(Cgt) -> print_string ">" - | Pcomp(Cge) -> print_string ">=" - | Poffsetint n -> print_int n; print_string "+" - | Poffsetref n -> print_int n; print_string "+:=" - | Pgetstringchar -> print_string "string.get" - | Psetstringchar -> print_string "string.set" - | Pvectlength -> print_string "array.length" - | Pgetvectitem -> print_string "array.get" - | Psetvectitem -> print_string "array.set" - -let rec lambda = function - Lvar id -> - Ident.print id - | Lconst cst -> - structured_constant cst - | Lapply(lfun, largs) -> - open_hovbox 2; - print_string "(apply"; print_space(); - lambda lfun; - List.iter (fun l -> print_space(); lambda l) largs; - print_string ")"; - close_box() - | Lfunction(param, body) -> - open_hovbox 2; - print_string "(function"; print_space(); Ident.print param; - print_space(); lambda body; print_string ")"; close_box() - | Llet(id, arg, body) -> - open_hovbox 2; - print_string "(let"; print_space(); - open_hvbox 1; - print_string "("; - open_hovbox 2; Ident.print id; print_space(); lambda arg; close_box(); - letbody body; - print_string ")"; - close_box() - | Lletrec(id_arg_list, body) -> - open_hovbox 2; - print_string "(letrec"; print_space(); - open_hvbox 1; - print_string "("; - let spc = ref false in - List.iter - (fun (id, l, sz) -> - if !spc then print_space() else spc := true; - Ident.print id; print_string " "; lambda l) - id_arg_list; - close_box(); - print_string ")"; - print_space(); lambda body; - print_string ")"; close_box() - | Lprim(prim, largs) -> - open_hovbox 2; - print_string "("; primitive prim; - List.iter (fun l -> print_space(); lambda l) largs; - print_string ")"; - close_box() - | Lswitch(larg, lo, hi, cases) -> - open_hovbox 1; - print_string "(switch "; print_int lo; print_string "/"; - print_int hi; print_space(); - lambda larg; print_space(); - open_vbox 0; - let spc = ref false in - List.iter - (fun (n, l) -> - open_hvbox 1; - print_string "case "; print_int n; print_string ":"; print_space(); - lambda l; - close_box(); - if !spc then print_space() else spc := true) - cases; - print_string ")"; close_box(); close_box() - | Lstaticfail -> - print_string "exit" - | Lcatch(lbody, lhandler) -> - open_hovbox 2; - print_string "(catch"; print_space(); - lambda lbody; print_break(1, -1); - print_string "with"; print_space(); lambda lhandler; - print_string ")"; - close_box() - | Ltrywith(lbody, param, lhandler) -> - open_hovbox 2; - print_string "(try"; print_space(); - lambda lbody; print_break(1, -1); - print_string "with "; Ident.print param; print_space(); - lambda lhandler; - print_string ")"; - close_box() - | Lifthenelse(lcond, lif, lelse) -> - open_hovbox 2; - print_string "(if"; print_space(); - lambda lcond; print_space(); - lambda lif; print_space(); - lambda lelse; print_string ")"; - close_box() - | Lsequence(l1, l2) -> - open_hovbox 2; - print_string "(seq"; print_space(); - lambda l1; print_space(); sequence l2; print_string ")"; - close_box() - | Lwhile(lcond, lbody) -> - open_hovbox 2; - print_string "(while"; print_space(); - lambda lcond; print_space(); - lambda lbody; print_string ")"; - close_box() - | Lfor(param, lo, hi, dir, body) -> - open_hovbox 2; - print_string "(for "; Ident.print param; print_space(); - lambda lo; print_space(); - print_string(match dir with Upto -> "to" | Downto -> "downto"); - print_space(); - lambda hi; print_space(); - lambda body; print_string ")"; - close_box() - | Lshared(l, lbl) -> - lambda l - -and sequence = function - Lsequence(l1, l2) -> - sequence l1; print_space(); sequence l2 - | l -> - lambda l - -and letbody = function - Llet(id, arg, body) -> - print_space(); - open_hovbox 2; Ident.print id; print_space(); lambda arg; - close_box(); - letbody body - | Lshared(l, lbl) -> - letbody l - | l -> - print_string ")"; - close_box(); - print_space(); - lambda l - |