=== modified file 'dcg_stuff.pl' --- dcg_stuff.pl 2012-05-17 01:48:06 +0000 +++ dcg_stuff.pl 2012-05-16 16:25:25 +0000 @@ -10,50 +10,20 @@ :- use_module(library(assoc)). -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Helpers for using assoc instead of list in DCG % -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -% Call predicate with previous and new value of key as arguments -% key #: append([foo, bar]) #:(Key,DCG_Goal,AssocIn,AssocOut) :- get_assoc(Key,AssocIn,ValIn,AssocOut,ValOut), phrase(DCG_Goal,ValIn,ValOut). -% Appends to a list which is a value of a key -% key #+ [foo, bar] #+(Key,List,AssocIn,AssocOut) :- get_assoc(Key,AssocIn,ValIn,AssocOut,ValOut), append(List,ValIn,ValOut). -% Assign value to a key -% key #= Value #=(Key,Value,AssocIn,AssocOut) :- put_assoc(Key, AssocIn, Value, AssocOut). -% Get a value of a key -% key #? Value #?(Key,Value,Assoc,Assoc) :- get_assoc(Key, Assoc, Value). -% Alternative to phrase/2 using empty assoc instead of list phrase_assoc(DCG_Goal, ValOut) :- empty_assoc(Empty), phrase(DCG_Goal, Empty, ValOut). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Maplist over DCG predicates % -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -dcg_maplist(_Pred, [ ]) --> []. -dcg_maplist( Pred, [Arg|Rest]) --> - call(Pred, Arg), - dcg_maplist(Pred, Rest). - -% Like dcg_maplist but ignores unsatisfiable predicates -dcg_maplist_permissive(_Pred, [ ]) --> []. -dcg_maplist_permissive( Pred, [Arg|Rest]) --> - ( call(Pred, Arg) -> [] ; [] ), - dcg_maplist_permissive(Pred, Rest). - === removed file 'shell.pl' --- shell.pl 2012-05-17 01:48:06 +0000 +++ shell.pl 1970-01-01 00:00:00 +0000 @@ -1,143 +0,0 @@ -% vim: ft=prolog textwidth=80 tabstop=4 softtabstop=4 shiftwidth=4 expandtab - -:- module(shell, [ - op(800,xfy,($:-)), ($:-)/2, -% op(800,fx,(#)), (#)/1, - cmd_format/2, - cmds_print/1, - cmd_repr/1, - cmds_repr/1, - ]). - -:- use_module(library(apply)). - -:- use_module(generic). -:- use_module(escape). - -%%%%%%%%%%%%%%%%%%%%%%%%% -% Shell code generation % -%%%%%%%%%%%%%%%%%%%%%%%%% - -escape(In, Out) :- escape(sh, In, Out). - -escape_dcg(In) --> - { escape(In, Out) }, - prepend(Out). - -escape_dcglist(List) --> - dcg_maplist(escape_dcg, List). - -str_dcg(In) --> - { str(In, Out) }, - prepend(Out). - -cmd_escape_runnable([Arg]) --> - escape_dcg(Arg). -cmd_escape_runnable([Arg1,Arg2|Rest]) --> - escape_dcg(Arg1), - prepend(" "), - cmd_escape_runnable([Arg2|Rest]). - -cmd_escape_runnable(echo(String)) --> - cmd_escape_runnable([echo, String]). - -cmd_escape_runnable(chroot(Dir, Args)) --> - cmd_escape_runnable([Dir +/+ 'chroot.sh'|Args]). - -check_returncode --> [" || exit $?\n"]. - -cmd_tokens(Runnable) --> - cmd_escape_runnable(Runnable), - check_returncode. - -cmd_tokens(Runnable >> File) --> - cmd_escape_runnable(Runnable), - prepend(" >>"), - escape_dcg(File), - check_returncode. - -cmd_tokens(Runnable > File) --> - cmd_escape_runnable(Runnable), - prepend(" >"), - escape_dcg(File), - check_returncode. - -cmd_tokens(Variable = Runnable) --> - str_dcg(Variable), - prepend("=\"$( "), - cmd_escape_runnable(Runnable), - prepend(" )\""), - check_returncode. - -cmd_tokens(Variable = Source $:- String) --> - str_dcg(Variable), - prepend("=\"${"), - str_dcg(Source), - prepend(":-"), - escape_dcg(String) - prepend("}\""), - check_returncode. - -cmd_tokens(Variable = Source $:- Runnable) --> - str_dcg(Variable), - prepend("=\"${"), - str_dcg(Source), - prepend(":-$( "), - cmd_escape_runnable(String) - prepend(" )}\""), - check_returncode. - -cmd_tokens(Variable = array(Runnable)) --> - str_dcg(Variable), - prepend("=( $("), - cmd_escape_runnable(Runnable), - prepend(") )"), - check_returncode. - -cmd_tokens(# Text) --> - prepend("\n# "), - { str(Text, String) } - make_comment(String), - prepend("\n"). - -cmd_tokens(run(List)) --> cmd_tokens(List). -cmd_tokens(run_append(List, File)) --> cmd_tokens(List >> File). -cmd_tokens(run_replace(List, File)) --> cmd_tokens(List > File). -cmd_tokens(run_outvar(List, Var)) --> cmd_tokens(Var = List). -cmd_tokens(run_outarray(List, Var)) --> cmd_tokens(Var = array(List)). -cmd_tokens(echo_append(String, File)) --> cmd_tokens(echo(String) >> File). -cmd_tokens(echo_replace(String, File)) --> cmd_tokens(echo(String) > File). -cmd_tokens(comment(Text)) --> cmd_tokens(# Text). - -make_comment([ ]) --> []. -make_comment([Char|Rest]) :- - ( { [Char] = "\n" } - -> prepend("\n# "), - ; prepend(Char) - ), - make_comment(Rest). - -cmd_format(Cmd, String) :- phrase(cmd_tokens(Cmd), [], String). - -cmds_print(Commands) :- - maplist(cmd_format, Commands, Lines), !, - str_join("\n", Lines, String), - name(Name,String), - nl, - write(Name), - nl. - -print_solution(Solution) :- - str_join('\n', Solution, String), name(Text, String), - write(Text), - nl, nl. - -cmd_repr(Command) :- - write('representation of: '), writeq(Command), write(' ::'), nl, - ( setof(Lines , maplist(cmd_format, [Command], Lines), Solutions) - -> maplist(print_solution, Solutions) - ; write('FAILED!'), nl, trace, cmd_format(Command, _) - ). - -cmds_repr(Commands) :- - maplist(cmd_repr, Commands). === modified file 'stagebuilder.pl' --- stagebuilder.pl 2012-05-17 01:48:06 +0000 +++ stagebuilder.pl 2012-05-16 07:46:53 +0000 @@ -10,7 +10,6 @@ :- use_module(generic). :- use_module(escape). -:- use_module(dcg_stuff). %%%%%%%%%%%% @@ -25,26 +24,116 @@ script_dir(Work +/+ scripts ) :- work_dir(Work). package_dir(Work +/+ packages ) :- work_dir(Work). +%%%%%%%%%%%%%%%%%%%%%%%%% +% Shell code generation % +%%%%%%%%%%%%%%%%%%%%%%%%% + +escape(In, Out) :- escape(sh, In, Out). + +check_returncode(Tokens, TokensChecked) :- + append(Tokens, ["||", "exit", "$?"], TokensChecked). + +cmd_tokens(run(List) , Checked) :- + maplist(escape, List, Escaped), + check_returncode(Escaped, Checked). +cmd_tokens( run_append(List, File) , Checked) :- + maplist(escape, List, Escaped0), + append(Escaped0, [">>", FileEscaped], Escaped), + escape(File, FileEscaped), + check_returncode(Escaped, Checked). +cmd_tokens(run_replace(List, File) , Checked) :- + maplist(escape, List, Escaped0), + append(Escaped0, [">", FileEscaped], Escaped), + escape(File, FileEscaped), + check_returncode(Escaped, Checked). +cmd_tokens( run_outvar(List, Var) , Checked) :- + maplist(escape, List, Escaped0), + str(Var, VarStr), + concat([VarStr, "=$("], Pre), + concat([[Pre], Escaped0, [")"]], Escaped), + check_returncode(Escaped, Checked). +cmd_tokens(run_outarray(List, Var) , Checked) :- + maplist(escape, List, Escaped0), + str(Var, VarStr), + concat([VarStr, "=( $("], Pre), + concat([[Pre], Escaped0, [") )"]], Escaped), + check_returncode(Escaped, Checked). +cmd_tokens( echo_append(String, File), Escaped) :- + cmd_tokens( run_append([echo, String], File), Escaped). +cmd_tokens(echo_replace(String, File), Escaped) :- + cmd_tokens(run_replace([echo, String], File), Escaped). +cmd_tokens(chroot(Dir, Args) , Escaped) :- + cmd_tokens(run([Dir +/+ 'chroot.sh'|Args]) , Escaped). +cmd_tokens(comment(Text), [Escaped]) :- + str(Text, String), + make_comment(String, EscapedString), + append("\n# ", EscapedString, Escaped). + +make_comment([ ], "\n"). +make_comment([Char|String], EscapedString) :- + ( [Char] = "\n" + -> append("\n# ", Rest, EscapedString) + ; EscapedString = [Char|Rest] + ), + make_comment(String, Rest). + +format_cmd(Cmd, String) :- + cmd_tokens(Cmd, Tokens), + str_join(" ", Tokens, String). + +% format_cmds(Cmds, Strings) :- +% maplist(format_cmd, Cmds, Strings). + +%print_cmds([ ]). +print_cmds(Commands) :- + maplist(format_cmd, Commands, Lines), !, + str_join("\n", Lines, String), + name(Name,String), + nl, + write(Name), + nl. + +print_solution(Solution) :- + str_join('\n', Solution, String), name(Text, String), + write(Text), + nl, nl. + +cmd_repr(Command) :- + write('representation of: '), writeq(Command), write(' ::'), nl, + ( setof(Lines , maplist(format_cmd, [Command], Lines), Solutions) + -> maplist(print_solution, Solutions) + ; write('FAILED!'), nl, trace, format_cmd(Command, _) + ). + +cmds_repr(Commands) :- + maplist(cmd_repr, Commands). + +debug_target(Name) :- + target(C, Name, builddir), + !, + write('Commands: '), + nl, + write(C), + nl, + cmds_repr(C). + %%%%%%%%%%%%%%%%%%%%%% % Gentoo stuff below % %%%%%%%%%%%%%%%%%%%%%% site_conf_file(Name, Dir +/+ Name) :- site_conf_dir(Dir). -unpack_stage_tarball(Tarball) --> - builddir #? Dir, - commands #+ [ run([tar, '-xpf', Tarball, '-C', Dir]) ]. - -create_stage_tarball(Tarball, AddOpts) --> - builddir #? Dir, - { script_dir(ScriptDir), - append(AddOpts, ['-pC', Dir, '.'], Opts) - }, - commands #+ [ run([ScriptDir +/+ tar_checksum, Tarball | Opts]) ], - -create_stage(Name) --> - { stages_dir(Stages) }, - create_tarball(Stages +/+ Name + '.tar.bz2', ['--use-compress-prog=pbzip2']). +unpack_tarball(Tarball, Dir) --> + [run([tar, '-xpf', Tarball, '-C', Dir])]. + +create_tarball(Tarball, Dir, AddOpts) --> + {script_dir(ScriptDir)}, + [run([ScriptDir +/+ tar_checksum, Tarball|Opts])], + {append(AddOpts, ['-pC', Dir, '.'], Opts)}. + +create_stage(Name, Dir) --> + {stages_dir(Stages)}, + create_tarball(Stages +/+ Name + '.tar.bz2', Dir, ['--use-compress-prog=pbzip2']). %http_glob(variable(uri), Uri) --> % {script_dir(ScriptDir)}, @@ -74,16 +163,15 @@ script_dir(ScriptDir), downloads_dir(DownloadsDir) }, - commands #+ [ - comment('download gentoo stage: ' + Name), - run([mkdir, '-p', DownloadsDir +/+ Name]), - run_outvar([ScriptDir +/+ resolve_txt_uri, - Mirror +/+ releases +/+ Arch +/+ autobuilds +/+ Txt - ], digest_uri), - run_outvar([ScriptDir +/+ download_stage, - variable(digest_uri), - DownloadsDir +/+ Name - ], downloaded) + [ comment('download gentoo stage: ' + Name) + , run([mkdir, '-p', DownloadsDir +/+ Name]) + , run_outvar([ScriptDir +/+ resolve_txt_uri + ,Mirror +/+ releases +/+ Arch +/+ autobuilds +/+ Txt + ], digest_uri) + , run_outvar([ScriptDir +/+ download_stage + , variable(digest_uri) + ,DownloadsDir +/+ Name + ], downloaded) ]. % @@ -354,81 +442,66 @@ append(FlatPackages, FlatRest, Joined), extract_package_names(Rest, FlatRest). -%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Command construction DCGs % -%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - % % altering make.conf % -dir_make_conf(Dir +/+ 'etc/make.conf') --> - build_dir #? Dir. +dir_make_conf(Dir, Dir +/+ 'etc/make.conf'). -configure_gentoo_packages(Packages) --> - { extract_package_names(Packages, PkgNames), - join(' ', PkgNames, PackagesJoined) +configure_gentoo_packages(Dir, Packages) --> + { extract_package_names(Packages, PkgNames), + join(' ', PkgNames, PackagesJoined) }, - commands #+ [ - comment('configure packages: ' + PackagesJoined), - echo_append('USE="' + JoinedUse + '"', Make_conf), - run([mkdir, '-p', Dir +/+ 'etc/portage/package.use']) + [ comment('configure packages: ' + PackagesJoined), + echo_append('USE="' + JoinedUse + '"', Make_conf), + run([mkdir, '-p', Dir +/+ 'etc/portage/package.use']) ], - { format_package_use(Packages, JoinedUse), - gentoo_package_echos(Packages, Dir, Commands), - dir_make_conf(Make_conf) + { format_package_use(Packages, JoinedUse), + gentoo_package_echos(Packages, Dir, Commands), + dir_make_conf(Dir, Make_conf) }, - commands #+ Commands. + prepend(Commands). -reset_make_conf(CXXFLAGS, CHOST) --> - commands #+ [ - comment('create new make.conf'), - echo_replace('#Autogenerated make.conf by ProSys\n' +reset_make_conf(Dir, CFLAGS, CXXFLAGS, CHOST) --> + [ comment('create new make.conf'), + echo_replace('#Autogenerated make.conf by ProSys\n' + 'CFLGAGS="' + CFLAGS + '"\n' + 'CXXFLAGS="' + CXXFLAGS + '"\n' - + 'CHOST="' + CHOST + '"\n', - Make_conf) - ], - { dir_make_conf(Make_conf) }. + + 'CHOST="' + CHOST + '"\n' + ,Make_conf + )], + {dir_make_conf(Dir, Make_conf)}. -append_site_make_conf --> - commands #+ [run_append([cat, Src], Dst)], +append_site_make_conf(Dir) --> + [run_append([cat, Src], Dst)], { site_conf_file('make.conf', Src), - dir_make_conf(Dst) + dir_make_conf(Dir, Dst) }. % % other auxiliary predicates % -set_timezone(Zone) --> - build_dir #? Dir, - commands #+ [ - run([rm, Dir +/+ '/etc/localtime']), - run([ln, '-s', '../usr/share/zoneinfo' +/+ Zone, Dir +/+ 'etc/localtime']) - ]. - -set_locale(Locale) --> - build_dir #? Dir, - commands #+ [ - echo_replace('LC_ALL="' + Locale + '"', Dir +/+ 'etc/env.d/02locale') - ]. - -create_chroot_script(Arch) --> - build_dir #? Dir, - commands #+ [ - run([cp, '-Lp', '--', Conf + '/chroot.sh-' + Arch, Dir +/+ 'chroot.sh']) - ], - { site_conf_dir(Conf) }. - -get_portage_timestamp(variable(portage_timestamp)) --> - { script_dir(Script) }, - commands #+ [ - run_outvar([Script +/+ portage_timestamp, '/usr/portage'], - portage_timestamp) - ]. - -% TODO make gentoo stage target from this +set_timezone(Dir, Zone) --> + [run([rm, Dir +/+ '/etc/localtime']), + run([ln, '-s', '../usr/share/zoneinfo' +/+ Zone, Dir +/+ 'etc/localtime']) + ]. + +set_locale(Dir, Locale) --> + [echo_replace('LC_ALL="' + Locale + '"', Dir +/+ 'etc/env.d/02locale')]. + +create_chroot_script(Dir, Arch) --> + [run([cp, '-Lp', '--', Conf + '/chroot.sh-' + Arch + , Dir +/+ 'chroot.sh' + ])], + {site_conf_dir(Conf)}. + +get_portage_timestamp(_Dir, variable(portage_timestamp)) --> + {script_dir(Script)}, + [run_outvar([Script +/+ portage_timestamp, '/usr/portage'], + portage_timestamp + )]. + create_gentoo_builddir(Name, Dir) --> {gentoo_stage(Name, ArchName, _)}, download_gentoo_stage(Tarball, Name), @@ -494,7 +567,9 @@ % targets % %%%%%%%%%%% -%% old old targets% {{{ +target(Commands, Name, Dir) :- + phrase(target(Name, Dir), Commands). + %target(i686_hardened_stage3, Dir) --> % create_gentoo_builddir(i686_hardened, Dir), % reset_make_conf(Dir, @@ -508,7 +583,7 @@ % %target(i586_geodelx_testing, Dir) --> % create_gentoo_builddir(i486, Dir), -% {dir_make_conf(Make_conf)}, +% {dir_make_conf(Dir, Make_conf)}, % reset_make_conf(Dir, % '-march=i586 -mtune=geode -O1 -pipe -fomit-frame-pointer', % '${CFLAGS}', @@ -521,7 +596,7 @@ % %target(i586_geodelx_uclibc, Dir) --> % create_gentoo_builddir(i486, Dir), -% {dir_make_conf(Make_conf)}, +% {dir_make_conf(Dir, Make_conf)}, % reset_make_conf(Dir, % '-march=i586 -mtune=geode -O1 -pipe -fomit-frame-pointer', % '${CFLAGS}', @@ -539,7 +614,7 @@ % %target(amd64_stable, Dir) --> % create_gentoo_builddir(amd64, Dir), -% %{dir_make_conf(Make_conf)}, +% %{dir_make_conf(Dir, Make_conf)}, % reset_make_conf(Dir, '-O2 -pipe', '${CFLAGS}' % ,'amd64-pc-linux-gnu'), % %[echo_append('ACCEPT_KEYWORDS="~amd64"', Make_conf)], @@ -554,7 +629,7 @@ % %target(amd64_mskp, Dir) --> % create_gentoo_builddir(amd64, Dir), -% %{dir_make_conf(Make_conf)}, +% %{dir_make_conf(Dir, Make_conf)}, % reset_make_conf(Dir, '-O2 -pipe', '${CFLAGS}' % ,'amd64-pc-linux-gnu'), % %[echo_append('ACCEPT_KEYWORDS="~amd64"', Make_conf)], @@ -573,7 +648,7 @@ % %target(amd64_testing, Dir) --> % create_gentoo_builddir(amd64, Dir), -% {dir_make_conf(Make_conf)}, +% {dir_make_conf(Dir, Make_conf)}, % reset_make_conf(Dir, '-O2 -pipe', '${CFLAGS}' % ,'amd64-pc-linux-gnu'), % [echo_append('ACCEPT_KEYWORDS="~amd64"', Make_conf)], @@ -589,7 +664,7 @@ % %target(amd64_hardened_vshost, Dir) --> % create_gentoo_builddir(amd64_hardened, Dir), -% {dir_make_conf(Make_conf)}, +% {dir_make_conf(Dir, Make_conf)}, % reset_make_conf(Dir, '-O2 -pipe', '${CFLAGS}' % ,'amd64-pc-linux-gnu'), % [echo_append('ACCEPT_KEYWORDS="~amd64"', Make_conf)], @@ -603,11 +678,10 @@ % %target(amd64_vserver_base, Dir) --> % amd64_hardened_vserver(amd64_vserver_base, [], Dir). -% }}} target(Name, Dir) --> % stable create_gentoo_builddir(StageName, Dir), - { dir_make_conf(Make_conf) + { dir_make_conf(Dir, Make_conf) , site_conf_file('make.conf', Site_conf) }, target_gentoo(BaseName, StageName, StageMax, Dir, [ @@ -620,7 +694,7 @@ target(Name, Dir) --> % testing create_gentoo_builddir(StageName, Dir), { gentoo_stage(StageName, ArchName, _) - , dir_make_conf(Make_conf) + , dir_make_conf(Dir, Make_conf) , site_conf_file('make.conf', Site_conf) }, target_gentoo(BaseName, StageName, StageMax, Dir, [ @@ -691,7 +765,7 @@ reset_make_conf(Dir, '-Os -march=prescott -pipe -fomit-frame-pointer' , '${CFLAGS}', 'i686-pc-linux-gnu'), prepend(AddCommands), - {dir_make_conf(Make_conf)}, + {dir_make_conf(Dir, Make_conf)}, [echo_append('VIDEO_CARDS="dummy fbdev vesa intel"', Make_conf)], configure_gentoo_packages(Dir ,[ package_list(common), package_list(laptop), @@ -715,7 +789,7 @@ %amd64_hardened_vserver(Name, Packages, Dir) --> % create_gentoo_builddir(amd64_hardened_nomulti, Dir), -% {dir_make_conf(Make_conf)}, +% {dir_make_conf(Dir, Make_conf)}, % reset_make_conf(Dir, '-O2 -pipe', '${CFLAGS}' % ,'amd64-pc-linux-gnu'), % [echo_append('ACCEPT_KEYWORDS="~amd64"', Make_conf)], @@ -728,36 +802,19 @@ % ]), % gentoo_build_stage4(Name, Dir). - -% non-dcg variant of target, sets up parameters and calls dcg variant -target(Name, Commands) :- - build_dir(BuildDir), - list_to_assoc([ commands-[] ], AssocIn), - phrase(target(Name), AssocIn, AssocOut), - get_assoc(commands, AssocOut, Commands). - -debug_target(Name) :- - target(C, Name, builddir), - !, - write('Commands: '), - nl, - write(C), - nl, - cmds_repr(C). - printnl(Text) :- print(Text), nl. main([ ]) :- - findall(Name , target(Name, _), Names), + findall(Name , target(_, Name, _), Names), maplist(printnl, Names). -main([Name]) :- - target(Name, Commands), +main([Name, Dir]) :- + target(Commands, Name, Dir), print('#!/bin/zsh -x\n\n# Generated by ProSys stagebuilder\n# Stage name: '), print(Name), nl, - cmds_print(Commands). + print_cmds(Commands). main([Name]) :- main([Name, variable('1')]).