Rush
11/29/2005 01:23:00 AM
compile.ml
, un des modules du compilo OCaml lui-même. Je vous laisse le soin de compiler ça avec tous les modules utilitaires du compilo Caml. Qu'est-ce que ça fait ? Ca définit un lambda-terme (au sens de lambda.mli
) qui affiche la fameuse chanson des 99 bottles of beer, un exemple courant de programme, un peu plus compliqué qu'un simple Hello World. Le lambda-terme est compilé en bytecode caml dans newt.cmo
puis linké, au final on obtient un exécutable thenewt
qui exécute le fameux algorithme.
open Misc
open Config
open Format
open Lambda
let init_path () =
load_path := "" :: (Clflags.std_include_dir ());
Env.reset_cache ()
let initial_env () =
Ident.reinit () ;
try
Env.open_pers_signature "Pervasives" Env.initial
with Not_found ->
fatal_error "cannot open pervasives.cmi"
let print_if printer arg =
fprintf Format.err_formatter "%a@." printer arg ;
arg
let (++) x f = f x
let implementation =
let modulename = "Newt" in
let env = init_path () ; initial_env () in
let objfile = "newt.cmo" in
let binfile = "thenewt" in
let oc = open_out_bin objfile in
let print_string =
let lid = Longident.Lident "print_string" in
let (path,_) = Env.lookup_value lid env in
transl_path path
in
let printf =
let lid = Longident.Ldot ((Longident.Lident "Printf"),"printf") in
let (path,_) = Env.lookup_value lid env in
transl_path path
in
let int n = Lconst (Const_base (Asttypes.Const_int n)) in
let string s = Lconst (Const_base (Asttypes.Const_string s)) in
let lambda =
(* setglobal (persistent Newt) *)
Lapply
(print_string,
[string "They turned me into a newt !\n"])
(* makeblock 0 *)
in
let bottles =
let more,one,nomore =
"%2d bottles of beer on the wall. Take one down, pass it around.\n",
"One bottle of beer on the wall. Take it down, pass it around.\n",
"No more bottles of beer.\n"
in
let id = Ident.create "nn" in
let eqthenelse x n t e =
Lifthenelse
((Lprim ((Pintcomp Ceq),[Lvar x;int n])),t,e)
in
let body =
let x = Ident.create "x" in
Lfunction
(Curried,[x],
(eqthenelse x 0
(Lapply (printf,[string nomore]))
(Lsequence
((eqthenelse x 1
(Lapply (printf,[string one]))
(Lapply (printf,[string more;Lvar x]))),
(Lapply (Lvar id,[Lprim (Psubint,[Lvar x;int 1])]))))))
in
Lletrec
([id,body],
(Lapply ((Lvar id),[int 99])))
in
let lambda = Lsequence (bottles,lambda) in
try
lambda
++ Simplif.simplify_lambda
++ print_if Printlambda.lambda
++ Bytegen.compile_implementation modulename
++ print_if Printinstr.instrlist
++ Emitcode.to_file oc modulename ;
close_out oc ;
Bytelink.link [objfile] binfile
with x ->
close_out oc ;
(* TODO remove file *)
raise x
def f(x):
return (x-1)
f("hop")
booish
, provoque une erreur à l'exécution. Si on essaie de le compiler avec booc
, on obtient une erreur statique, mais il s'agit de la défaite de l'inférence, qui ne cherche pas à spécialiser x
et le considère comme un objet en général, puis s'indigne qu'on cherche à utiliser la soustraction. En gros il faut préciser x as int
.