diff options
Diffstat (limited to 'bytecomp/printlambda.ml')
| -rw-r--r-- | bytecomp/printlambda.ml | 19 |
1 files changed, 16 insertions, 3 deletions
diff --git a/bytecomp/printlambda.ml b/bytecomp/printlambda.ml index 7e9c197e3..1b9085edd 100644 --- a/bytecomp/printlambda.ml +++ b/bytecomp/printlambda.ml @@ -86,14 +86,22 @@ let record_rep ppf r = | Record_regular -> fprintf ppf "regular" | Record_inlined i -> fprintf ppf "inlined(%i)" i | Record_float -> fprintf ppf "float" - | Record_exception p -> fprintf ppf "exn (%s)" (Path.name p) + | Record_extension -> fprintf ppf "ext" ;; +let string_of_loc_kind = function + | Loc_FILE -> "loc_FILE" + | Loc_LINE -> "loc_LINE" + | Loc_MODULE -> "loc_MODULE" + | Loc_POS -> "loc_POS" + | Loc_LOC -> "loc_LOC" + let primitive ppf = function | Pidentity -> fprintf ppf "id" | Pignore -> fprintf ppf "ignore" | Prevapply _ -> fprintf ppf "revapply" | Pdirapply _ -> fprintf ppf "dirapply" + | Ploc kind -> fprintf ppf "%s" (string_of_loc_kind kind) | Pgetglobal id -> fprintf ppf "global %a" Ident.print id | Psetglobal id -> fprintf ppf "setglobal %a" Ident.print id | Pmakeblock(tag, Immutable) -> fprintf ppf "makeblock %i" tag @@ -231,6 +239,7 @@ let primitive ppf = function else fprintf ppf "bigarray.array1.set64" | Pbswap16 -> fprintf ppf "bswap16" | Pbbswap(bi) -> print_boxed_integer "bswap" ppf bi + | Pint_as_pointer -> fprintf ppf "int_as_pointer" let rec lam ppf = function | Lvar id -> @@ -313,8 +322,12 @@ let rec lam ppf = function if !spc then fprintf ppf "@ " else spc := true; fprintf ppf "@[<hv 1>case \"%s\":@ %a@]" (String.escaped s) lam l) cases; - if !spc then fprintf ppf "@ " else spc := true; - fprintf ppf "@[<hv 1>default:@ %a@]" lam default in + begin match default with + | Some default -> + if !spc then fprintf ppf "@ " else spc := true; + fprintf ppf "@[<hv 1>default:@ %a@]" lam default + | None -> () + end in fprintf ppf "@[<1>(stringswitch %a@ @[<v 0>%a@])@]" lam arg switch cases | Lstaticraise (i, ls) -> |