Compare commits
3 commits
6c5580d550
...
b00976d359
Author | SHA1 | Date | |
---|---|---|---|
Théophile Bastian | b00976d359 | ||
Théophile Bastian | 38148932f7 | ||
Théophile Bastian | 324e32c15e |
|
@ -51,9 +51,13 @@ let rec cps_term_inner (t: S.term) (cont: T.variable) (nameHint: string option)
|
||||||
and fCont = freshBlockVar () in
|
and fCont = freshBlockVar () in
|
||||||
let xVal = freshVarHinted nameHint
|
let xVal = freshVarHinted nameHint
|
||||||
and fVal = freshVar () in
|
and fVal = freshVar () in
|
||||||
letCont fCont fVal (T.TailCall(T.vvar fVal, T.vvars [xVal; cont])) @@
|
|
||||||
letCont xCont xVal (cps_term_inner f fCont None) @@
|
letCont xCont xVal (
|
||||||
|
letCont fCont fVal
|
||||||
|
(T.TailCall(T.vvar fVal, T.vvars [xVal; cont])) @@
|
||||||
|
(cps_term_inner f fCont None)) @@
|
||||||
cps_term_inner x xCont None
|
cps_term_inner x xCont None
|
||||||
|
|
||||||
| S.Print term ->
|
| S.Print term ->
|
||||||
let curCont = freshBlockVar ()
|
let curCont = freshBlockVar ()
|
||||||
and termVal = freshVar () in
|
and termVal = freshVar () in
|
||||||
|
|
24
src/Main.ml
24
src/Main.ml
|
@ -5,6 +5,9 @@
|
||||||
let debug =
|
let debug =
|
||||||
ref false
|
ref false
|
||||||
|
|
||||||
|
let light_debug =
|
||||||
|
ref false
|
||||||
|
|
||||||
let filenames =
|
let filenames =
|
||||||
ref []
|
ref []
|
||||||
|
|
||||||
|
@ -14,6 +17,7 @@ let record filename =
|
||||||
let options =
|
let options =
|
||||||
Arg.align [
|
Arg.align [
|
||||||
"--debug", Arg.Set debug, " Enable debugging output";
|
"--debug", Arg.Set debug, " Enable debugging output";
|
||||||
|
"--light-debug", Arg.Set light_debug, " Enable debugging output";
|
||||||
]
|
]
|
||||||
|
|
||||||
let usage =
|
let usage =
|
||||||
|
@ -24,6 +28,8 @@ let () =
|
||||||
|
|
||||||
let debug =
|
let debug =
|
||||||
!debug
|
!debug
|
||||||
|
let light_debug =
|
||||||
|
!light_debug
|
||||||
|
|
||||||
let filenames =
|
let filenames =
|
||||||
List.rev !filenames
|
List.rev !filenames
|
||||||
|
@ -36,8 +42,8 @@ let print_delimiter () =
|
||||||
Printf.eprintf "----------------------------------------";
|
Printf.eprintf "----------------------------------------";
|
||||||
Printf.eprintf "----------------------------------------\n"
|
Printf.eprintf "----------------------------------------\n"
|
||||||
|
|
||||||
let dump (phase : string) (show : 'term -> string) (t : 'term) =
|
let dump (phase : string) (show : 'term -> string) (light: bool) (t : 'term) =
|
||||||
if debug then begin
|
if debug || (light_debug && light) then begin
|
||||||
print_delimiter();
|
print_delimiter();
|
||||||
Printf.eprintf "%s:\n\n%s\n\n%!" phase (show t)
|
Printf.eprintf "%s:\n\n%s\n\n%!" phase (show t)
|
||||||
end;
|
end;
|
||||||
|
@ -82,17 +88,17 @@ let output (p : C.program) : unit =
|
||||||
let process filename =
|
let process filename =
|
||||||
filename
|
filename
|
||||||
|> read
|
|> read
|
||||||
|> dump "RawLambda" RawLambda.show_term
|
|> dump "RawLambda" RawLambda.show_term false
|
||||||
|> Cook.cook_term
|
|> Cook.cook_term
|
||||||
|> dump "Lambda" Lambda.show_term
|
|> dump "Lambda" Lambda.show_term false
|
||||||
|> CPS.cps_term
|
|> CPS.cps_term
|
||||||
|> dump "Tail" Tail.show_term
|
|> dump "Tail" Tail.show_term false
|
||||||
|> dump "PrettyTail" PrettyTail.show
|
|> dump "PrettyTail" PrettyTail.show true
|
||||||
|> Defun.defun_term
|
|> Defun.defun_term
|
||||||
|> dump "Top" Top.show_program
|
|> dump "Top" Top.show_program false
|
||||||
|> dump "PrettyTop" PrettyTop.show
|
|> dump "PrettyTop" PrettyTop.show true
|
||||||
|> Finish.finish_program
|
|> Finish.finish_program
|
||||||
|> dump "C" C.show_program
|
|> dump "C" C.show_program false
|
||||||
|> output
|
|> output
|
||||||
|
|
||||||
(* -------------------------------------------------------------------------- *)
|
(* -------------------------------------------------------------------------- *)
|
||||||
|
|
|
@ -23,4 +23,4 @@ and fmt_term fmt (t: S.term) = match t with
|
||||||
fmt_var var fmt_block block fmt_term next
|
fmt_var var fmt_block block fmt_term next
|
||||||
|
|
||||||
let show term =
|
let show term =
|
||||||
Format.asprintf "%a" fmt_term term
|
Format.asprintf "@[<v 0>%a@]" fmt_term term
|
||||||
|
|
Loading…
Reference in a new issue