MODULE compiler. INCLUDE 'constant.h' INCLUDE 'msglib.h' INCLUDE 'iolib.h' INCLUDE 'prolib.h' INCLUDE 'winlib.h' INCLUDE 'sysman.h' EXPORT compiler. % make the predicate accessible % predicate = module name => % can be started from the host server PREDICATE compiler. compiler:- load_compiler, % install compiler pipeline first makewindow(_,40,86,10,30,"Compiler Input"), process_name(compiler_input), % gives this process a name for the<p> % host servers process list trace(on), % in case you want to see BAP working repeat, % final commitment clearwindow, % start a new game write(' BRAIN AID PROLOG V1.1 '),nl, write(' (c) 1993 by Frank Bergmann,'),nl, write(' Martin Ostermann'),nl, write(' Guido von Walter'),nl, nl, get_params(Name,Flags), % prompt the user to set options compile(Name,Flags), % pass the command to the compiler fail. PREDICATE get_params(string,voidlist). get_params(_,_):- % initialize database not(database(flags(_))), % for use in display_flags asserta(flags([])), fail. get_params(Name,Flags):- display_flags(Flags), % do the actual work readln(Name),!. PREDICATE display_flags(voidlist). display_flags(Flags):- write("Press escape to change flags\n"), database(flags(Flags)), write("Flags: ",Flags,"\n"), write("Name : "). % know the readln in get_params % becomes active. If the user <p> % presses escape it will fail % and the second clause is entered: display_flags(_):- retractall(flags(_)), % make a new start asserta(flags([])), clearwindow, write("Press <RETURN> to confirm\nPress <ESC> to ignore\n\n"), % first get possible options and % their descriptions out of a list member(flag(String,Flag),[ flag("Trace on? ",trace), flag("disable optimizing? ",no_opt) ]), write("\t",String), readln(_), % display and prompt for each option retract(flags(Old)), % readln(_) succeeded, thus the user append(Old,[Flag],New), % wants this option active: asserta(flags(New)), % add it to the list ... fail. % ... and loop % that's all
%**************************************************************** % % % MAKE Utility % % Version 1.00, 16.10.93 by Gbr Frank Bergmann % Martin Ostermann % Guido von Walter<p> % BRAIN AID SYSTEMS % %**************************************************************** MODULE make. INCLUDE 'prolib.h' INCLUDE 'msglib.h' INCLUDE 'iolib.h' EXPORT make(string). % this is the entry point PREDICATE get_makefile(atom). get_makefile(no):- % don't reload upon recursion database(loaded),!. get_makefile(_):- consult('bap.mkf'), % get current 'makefile' assertz(loaded), % remember we did it retract(bap2lkd(Name,Rest)), % treat any short notations concat(Name,".lkd",Target), concat(Name,".bap",Dependence), assertz(entry(Target,[Dependence|Rest],compile(Name))), fail. get_makefile(yes):- write("consulting done"),nl. PREDICATE make(string). make(Target):- free(Target), % if target is unbound database(entry(Target,_,_)),!,% get the first entry make(Target). % as default target make(Target):- get_makefile(Loaded), % see if makefile must be loaded ( database(entry(Target,Dependencies,Actions)), ( Dependencies = [], % the user put it in to execute(Actions) % do some actions no matter % what! ; member(X,Dependencies), % no check all dependencies make(X), % if they need to be remaked fail ; % see if WE need a remake test_make(Target,Dependencies,Actions) ),fail ; Loaded = yes, % we loaded it, so we retractall(entry(_,_,_)), % clean it up as well retractall(loaded) ; Loaded = no % just a recursion done ... ). PREDICATE test_make(string,string,string). test_make(Target,Dependencies,Actions):- member(X,Dependencies), % for all dependencies newer(X,Target),!, % check their existence execute(Actions). % execute if target % is older than dependency PREDICATE newer(string,string). newer(Dependence,Target):- not(filedate(_,Target)),! % check if target does not exists % than we must built it no matter % what ; filedate(TargetDate,Target), % get both filedates filedate(DependenceDate,Dependence), TargetDate < DependenceDate,!.% that's it PREDICATE execute(void). % inform user and execute execute(Actions):- ( Actions = true ; write(Actions),nl ),!, call(Actions),!. % that's all
Example: 'bap.mkf'
entry(demo,["demo.lkd","queens.lkd","pie.lkd"],true). bap2lkd(demo,[]). bap2lkd(queens,[]). bap2lkd(pie,[]). bap2lkd(par,[]). entry(world ,[ "world.lkd", "worldinc.lkd", "worlddrw.lkd", "worldobj.lkd", "auxpred.lkd", "worldspc.lkd" ],true). bap2lkd(world,[]). bap2lkd(worldinc,[]). bap2lkd(worlddrw,[]). bap2lkd(worldobj,[]). bap2lkd(worldspc,[]). bap2lkd(auxpred,[]).
You might want to step some examples through. E.g. try make('par.lkd'), make(world), make(_).
Remember that build only reacts if something has to be done! So you cannot repeat an example without deleting the target file first (or redateing the dependency (source) ).