/*-------------------------------------------------------------------------*/ /* Prolog to Wam Compiler INRIA Rocquencourt - ChLoE Project */ /* Compiler Daniel Diaz - 1991 */ /* */ /* predicat d'appel: wamcc(CommandLine) */ /* */ /* entree */ /* CommandLine: a file name or a list of options and file names */ /* */ /* Generalites: */ /* */ /* ! : Les seuls cuts (!) indispensables sont signales (% cut important)*/ /* ils sont au nombre de 5 en debut de programme. TOUS les autres */ /* cuts peuvent etre supprimes, ils ne sont la que pour eviter de */ /* trop empiler de points de choix inutiles. */ /* */ /* Fin : Cette variable est utilisee pour faire des ajouts en fin de liste*/ /* en temps constant. L'idee est d'utiliser une liste terminee par */ /* cette variable Fin, et de garder celle-ci "a portee de main". */ /* Pour ajouter un element E a la liste L il suffit d'unifier la */ /* variable Fin avec [E|Fin1]. La nouvelle variable Fin sera Fin1. */ /* Lorsqu'il n'y a plus d'elements a inserer il suffit d'unifier la */ /* variable Fin courante avec []. */ /* */ /* LSuiv: LSuiv est une liste a placer en fin de liste resultat. Elle sert */ /* a eviter un append. Exemple: */ /* */ /* au lieu de: */ /* f(L1,L2,R) :- trait(L1,R1), trait(L2,R2), append(R1,R2,R). */ /* */ /* trait([],[]). */ /* trait([E|L],[E1|R]):- modif(E,E1),trait(L,R). */ /* */ /* on ecrit: */ /* f(L1,L2,R1):- trait(L1,R2,R1), trait(L2,[],R2). */ /* */ /* trait([],LSuiv,LSuiv). */ /* trait([E|L],LSuiv,[E1|R]):- modif(E,E1), trait(L,LSuiv,R). */ /* */ /* global variables (g_assign/2, g_read/2): */ /* */ /* options:mode_c=t/f fast_math=t/f no_inline=t/f debug=0-2 verbose=t/f*/ /* */ /* others: module, fic_in, fic_out, fic_h, fic_usr (files) */ /* file_nb: file counter (as a key for info about predicates) */ /* aux (auxiliary counter) */ /* nb_clause_exe ('$exe_i' clause counter, i.e. directives) */ /* nb_clause_dyn ('$dyn_j' clause counter, i.e. dynamic clauses) */ /*-------------------------------------------------------------------------*/ :- main([wamcc0,wamcc1,wamcc2,wamcc3,wamcc4,wamcc5,wamcc6,wamcc7,wamcc8]). wamcc(CmdLine):- (cmd_line(CmdLine,LFic) -> (g_read(verbose,t) -> display_version ; true), compile1(LFic) ; display_version, display_help, error('')). compile1([]):- !. % cut important compile1([Fic|LFic]):- !, % cut important (compile2(Fic), fail ; true), % gc compile1(LFic). compile2(Fic):- cree_noms_fic(Fic), (g_read(verbose,t) -> g_read(fic_in,FicIn), formata('Compiling ~w...~n',[FicIn]) ; true), g_assign(aux,1), lire_fichier(LSrc,Main), compiler(LSrc,Main), !. % cut important compile2(_):- seen, told, error(' ... Fail'). cree_noms_fic(Fic):- atom_length(Fic,L), P is L-2, (sub_atom(Fic,P,3,'.pl') -> L1 is P-1, sub_atom(Fic,1,L1,Prefix), FicIn=Fic ; Prefix=Fic, atom_concat(Prefix,'.pl',FicIn)), (g_read(mode_c,t) -> atom_concat(Prefix,'.c',FicOut), atom_concat(Prefix,'.h',FicH), atom_concat(Prefix,'.usr',FicUsr) ; atom_concat(Prefix,'.wam',FicOut), FicH=null, FicUsr=null), base_name(Prefix,Module), g_assign(module,Module), g_assign(fic_in,FicIn), g_assign(fic_out,FicOut), g_assign(fic_h,FicH), g_assign(fic_usr,FicUsr). base_name(Prefix,Module):- (sub_atom(Prefix,P,1,'/') -> atom_length(Prefix,L), P1 is P+1, L1 is L-P, sub_atom(Prefix,P1,L1,Prefix1), base_name(Prefix1,Module) ; Module=Prefix). cmd_line(CmdLine,LFic):- ((CmdLine=[_|_] ; CmdLine==[]) -> CmdLine1=CmdLine ; CmdLine1=[CmdLine]), set_default_options, cmd_line1(CmdLine1,LFic). cmd_line1([],[]). cmd_line1([Opt|CmdLine],LFic):- (Opt= -Opt1, ! ; sub_atom(Opt,1,1,'-'), !, atom_length(Opt,L), L1 is L-1, sub_atom(Opt,2,L1,Opt1)), traite_opt(Opt1), cmd_line1(CmdLine,LFic). cmd_line1([Fic|CmdLine],[Fic|LFic]):- cmd_line1(CmdLine,LFic). set_default_options:- g_assign(mode_c, t), g_assign(fast_math, f), g_assign(no_stack_test,f), g_assign(no_inline, f), g_assign(debug, 0), g_assign(verbose, f). traite_opt(c):- g_assign(mode_c, t). traite_opt(wam):- g_assign(mode_c, f). traite_opt(fast_math):- g_assign(fast_math, t). traite_opt(no_stack_test):- g_assign(no_stack_test, t). traite_opt(no_inline):- g_assign(no_inline, t). traite_opt(dbg0):- g_assign(debug, 0). traite_opt(dbg):- g_assign(debug, 1). traite_opt(dbg1):- g_assign(debug, 1). traite_opt(dbg2):- g_assign(debug, 2). traite_opt(v):- g_assign(verbose, t). :- public display_version/0. display_version:- !, ProgramCmt='Prolog to Wam Compiler', wam_version(V), wam_year(Y), name(ProgramCmt,SProgramCmt), length(SProgramCmt,LC), name(V,SV), length(SV,LV), DC is 40-LC, DV is 45-LV, formata('~s~*c INRIA Rocquencourt - ChLoE Project~n',[SProgramCmt,DC,32]), formata('Version ~s~*c Daniel Diaz - ~d~n~n',[SV,DV,32,Y]). display_help:- compiler_name(Name), formata('Usage:~n~n',[]), formata(' ~w [option | filename]...~n~n',[Name]), formata('Options:~n~n',[]), formata(' -c produce a .c file~n',[]), formata(' -wam produce a .wam file~n',[]), formata(' -fast_math do not test types in math expressions~n',[]), formata(' -no_stack_test do not include additional code to test stack overflow~n',[]), formata(' -no_inline do not inline any builtin predicates~n',[]), formata(' -dbg compile for prolog debugging~n',[]), formata(' -dbg2 compile for prolog and wam debugging~n',[]), formata(' -v verbose mode~n',[]), formata(' -h display help~n',[]). compiler(LSrc,Main):- g_read(mode_c,ModeC), exec_passes(LSrc,LClComp), !, cree_paquets(LClComp,LPaq), !, exec_indexation(LPaq,LPaqW), !, (ModeC==f -> wam_emission(LPaqW) ; c_emission(LPaqW,Main)). exec_passes([],[]). exec_passes([ClSrc|LSrc],[clcomp(Pred,Arg1,W)|LClComp]):- sucre_syntaxique(ClSrc,LSrc,ClSrc1,LSrc1), !, format_interne(ClSrc1,Arg1,T,C,NbChunk), !, classif_variables(T,C), !, generation_code(T,C,NbChunk,Pred,W), !, allocation_varsX(W), !, exec_passes(LSrc1,LClComp). cree_paquets([],[]). cree_paquets([ClComp|LClComp],LPaq1):- cree_paquets(LClComp,LPaq), ajout_clause(LPaq,ClComp,LPaq1), !. ajout_clause(LPaq,ClComp,[Paq|LPaq1]):- % replace paquet devant trouve_paquet(LPaq,ClComp,Paq,LPaq1). trouve_paquet([],clcomp(Pred,Arg1,W),paq(Pred,[Cl]),[]):- format_index(Arg1,W,Cl). trouve_paquet([paq(Pred,LCl)|LPaq],clcomp(Pred,Arg1,W),paq(Pred,[Cl|LCl]),LPaq):- format_index(Arg1,W,Cl). trouve_paquet([Paq|LPaq],ClComp,Paq1,[Paq|LPaq1]):- trouve_paquet(LPaq,ClComp,Paq1,LPaq1). format_index(Arg1,W,cl(_,Arg1,W)). % pour indexation exec_indexation([],[]). exec_indexation([paq(Pred,LCl)|LPaq],[paq(Pred,LClW)|LPaqW]):- indexation(LCl,LClW), !, exec_indexation(LPaq,LPaqW). /*--- Gestion des ensembles (sans unification) ----------------------------*/ :- public ens_ajout/3, ens_retrait/3, ens_elt/2, ens_inter/3, ens_union/3, ens_compl/3. ens_ajout([],X,[X]). ens_ajout([Y|L],X,[Y|L]):- X==Y, !. ens_ajout([Y|L],X,[Y|L1]):- ens_ajout(L,X,L1). ens_retrait([Y|L],X,L):- % ens_retrait(L,X,L1) echoue si X==Y, % X n'appartient pas a L !. ens_retrait([Y|L],X,[Y|L1]):- ens_retrait(L,X,L1). ens_elt([Y|_],X):- X==Y, !. ens_elt([_|L],X):- ens_elt(L,X). ens_inter([],_,[]). ens_inter([X|L1],L2,[X|L3]):- ens_elt(L2,X), !, ens_inter(L1,L2,L3). ens_inter([_|L1],L2,L3):- ens_inter(L1,L2,L3). ens_union([],L2,L2). ens_union([X|L1],L2,L3):- ens_elt(L2,X), !, ens_union(L1,L2,L3). ens_union([X|L1],L2,[X|L3]):- ens_union(L1,L2,L3). ens_compl([],_,[]). ens_compl([X|L],L1,L3):- (ens_elt(L1,X) -> L3=L2 ; L3=[X|L2]), ens_compl(L,L1,L2). /*--- Erreurs -------------------------------------------------------------*/ :- public error/1. error(Err):- write(Err), nl, abort. /*--- Unix interface ------------------------------------------------------*/ go:- unix(argv(L)), (L\==[] -> wamcc(L), halt_or_else(0,true) ; true). :- go.