/*-------------------------------------------------------------------------*/
/* 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.
syntax highlighted by Code2HTML, v. 0.9.1