In article <3f0c65$qv8@info4.rus.uni-stuttgart.de>,
Monika Sester <monika.sester@ifp.uni-stuttgart.de> wrote:
>hi,
>my program is producing new programs which it is able to execute.
>however they don't look very nice.
>is there a possibility to justify the code of the newly produced
>program directly from my program ?
>i.e. is there a routine like the compilation-routine, which does this
>justification ?
>
>compile('new_file.p');
>justify('new_file.p');
The code below for "compile_and_output" may go some distance towards
fulfilling the requirement. Note that it needs the "example" macro,
included below.
compile_and_output takes a list of items, compiles them in the normal
way, but also outputs them roughly formatted on a specified character
repeater. A sample of this output is reproduced below. I have
subsequently slightly improved "while". I can think of better ways to
do it (e.g. using vedopeners...) but life is short...
=============================================================================
;;; A sample output, generated by my parser-generator
============================================================================
define expr_seq ( L ) -> ( t_out , L1 ) ;
lvars L , L0 , L1 , t_out = undef , t1 , t2 , t3 ,
t4 , t5 , t6 , t7 , t8 , t9 ;
if ( L -> L1 ;
lblock
lvars n = 0 ;
[ %
lvars t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 , t_out ,
L_prev = L1 , n = 0 ;
while ( expr ( L1 ) -> ( t1 , L1 ) , L1 )
then t1 ;
L1 -> L_prev ;
; endwhile ;
L_prev -> L1 ;
% ] ;
true endlblock -> t_out ;
-> t1 ;
t_out ;
)
and ( ( t1 ) -> t_out , true )
then return
else false -> L1
endif
enddefine ;
=============================================================================
;;; compile_and_output.p R.J.Popplestone may 1992
;;; Compile a list of POP-11 code and also output it to the repeater Rep_code
section COMPILE_AND_OUTPUT => compile_and_output, compile_and_output_list;
vars procedure(compile_and_output_list,
compile_as_if_quoted,
pr_string,
is_unquotable);
define compile_and_output(L,Rep_code);
lvars L, Rep_code,
i = 0, ;;; Count of chars. on line.
L1=L,
rep_now = cucharout;
dlocal pop_pr_quotes = true, ;;; Print quote characters.
cucharout = Rep_code; ;;; Direct output to code file.
until null(L1) do
lvars l = hd(L1);
if l == "if" ;;; These words go on a new-line
or l == "else"
or l == "elseif" ;;; and are indented.
or l == "endif"
or l == "procedure"
or l == "while"
or l == "endprocedure"
or l == "endwhile"
or l == "lvars" then nl(1); sp(2); 2->i;
elseif l == "define" then nl(2); 0->i; ;;; Separate function defns.
elseif l == "enddefine" then nl(1); 0->i; ;;; New-line, no indentation.
elseif l == "and"
or l == "then" then nl(1); sp(4);4->i; ;;; New-line, indent 4 spaces.
endif;
if islist(l) then
compile_and_output_list(l,Rep_code);
elseif not(l) then pr("false"); sp(1);
elseif l == true then pr("true"); sp(1);
elseif l == """ then
compile_as_if_quoted(L1.tl.hd) + i -> i;
L1.tl.tl->L1;
elseif isstring(l) then
pr_string(l); sp(1); i + datalength(l) + 3 -> i;
else
pr(l); sp(1); i+datalength(l sys_><'')+1 -> i; ;;; Print the item.
endif;
if l == ";" and i > 10 then nl(1); sp(6); 6->i;
elseif l == "," and i > 50 then nl(1); sp(8); 8->i;
endif;
L1.tl -> L1;
enduntil;
rep_now -> cucharout; ;;; Direct output to default repeater.
compile(L);
enddefine;
;;; Print a string in a form suitable for the POP-11 compiler.
define pr_string(Str);
lvars Str,i,n = datalength(Str);
cucharout(`'`);
for i from 1 to n do
lvars c = Str(i);
if c = `'` or c = ``` then cucharout(`\\`);
endif;
cucharout(c);
endfor;
cucharout(`'`);
enddefine;
/*example pr_string
nl(1); pr_string('** the\` is \' OK');
'** the\` is \' OK'
endexample*/
;;; For example see later
define compile_and_output_list(L,Rep_code);
lvars l,L,Rep_code i = 0;
dlocal cucharout = Rep_code;
pr("[");
for l in L do;
if islist(l) then compile_and_output_list(l,Rep_code)
elseif isword(l) then
if l == "[" or l == "]"
or l == "{" or l == "}"
or is_unquotable(l) then
pr('^(');
compile_as_if_quoted(l);
pr(') ');
else pr(l); sp(1);
endif;
if i > 10 then 0 -> i; nl(1); ;;; Put out a new line to stop line
else i+1 -> i; ;;; of code getting too long.
endif;
elseif isstring(l) then
pr_string(l);
else pr(l); sp(1);
endif;
endfor;
pr("]");
enddefine;
define is_unquotable(Word);
lvars c = subscrw(1,Word);
c == `.` or c == `\`` or c == `\'`
enddefine;
;;; Normally quotes Obj as a POP word, but if it can't be a POP word by
;;; POP lexical rules, it makes one out of a string. n is the
;;; number of spaces it takes.
define compile_as_if_quoted(Obj) -> n;
lvars Obj, n, m = datalength(Obj);
if isword(Obj) then
if is_unquotable(Obj) then
dlocal pop_pr_quotes = false;
pr('consword('); pr_string(Obj); pr(')');
m + 8 -> n;
else pr("""); pr(Obj); pr(""");
m + 2 -> n;
endif;
else
pr(Obj);
endif;
enddefine;
example compile_as_if_quoted
pr('** '); erase(compile_as_if_quoted("fred"));
** "fred"
pr('** '); erase(compile_as_if_quoted(consword('...')));
** consword('...')
endexample
/*
pr('** '); compile_as_if_quoted(consword('\''));
*/
endsection;
==============================================================================
;;; example.p R.J.Popplestone January 1990
;;; The macro example provides for self-checking of programs. It reads lines
;;; of text until endexample is encountered. Any line not beginning with '**'
;;; is compiled, and any output is recorded in a string, ss_out. Any line
;;; beginning with '**' is read into a string, which is compared with ss_out.
;;; If there is a difference, a warning message is printed out.
section examples => example /*sss,sss_out*/, endexample example_off;
vars n_call, ss_out,i_out, procedure(out_to_string);
vars example_off = false;
;;; example <f> <examples> endexample runs the examples and checks output OK
;;; Disabling the example macro.
/*
define macro example;
until readitem() = "endexample" do
enduntil
enddefine;
*/
lvars n_ss_out = 200;
define macro example; ;;; Full explanation at TOP of FILE
lvars f_name = readstringline(); ;;; Read function name (ignored)
printf('example %p\n', [%f_name%]);
dlocal cucharout,
popgctrace = false, ;;; Turn off tracing of garbage coll.
tracing = false, ;;; Turn off tracing.
n_call = callstacklength(1); ;;; Used for exit at endexample
dlocal pr = syspr;
dlocal prautoloadwarn = erase;
;;; lvars i_out;
dlocal ss_out = inits(n_ss_out);
for i_out from 1 to n_ss_out do ` ` -> subscrs(i_out,ss_out)
endfor;
define lvars prmishap_example(Msg,Culprits); lvars Msg,Culprits;
dlocal cucharout = cucharerr;
printf('Error in example %p in file = %p\n',
[%f_name,pdprops(cucharin)%]);
printf('ignore line number below');
sysprmishap(Msg,Culprits);
enddefine;
dlocal prmishap = prmishap_example;
repeat lvars ss = readstringline(); ;;; Read the next line of text
;;; ss -> sss; ss_out -> sss_out;
if example_off then
if issubstring('endexample',ss)
then return
endif;
elseif ss.datalength>=2 ;;; Begins with ** ?
and ss(1) = `*`
and ss(2) = `*` then ;;; If so, compare with previous
unless issubstring(ss,ss_out)=1 ;;; output, they should be
and i_out <= datalength(ss)+3 ;;; identical substrings.
then ;;; Not identical, so print
charout -> cucharout; ;;; error message
pr('\nexample failed for ');
pr(f_name);
pr('.\n Expected ');
pr(ss);
pr('\n Produced ');
pr(ss_out); nl(1); ;;;.setpop;
endunless;
else ;;; Line did not begin with **
dlocal ;;; switch standard output to
cucharout = out_to_string(); ;;; the string ss_out
lvars Rep = stringin(ss);
pdprops(cucharin) -> pdprops(Rep);
pop11_compile(Rep); ;;; and compile the example line.
endif;
endrepeat
enddefine;
define out_to_string; ;;; is a (not very subtle) consumer.
1->i_out;
procedure(c);
c -> ss_out(i_out); i_out+1 -> i_out;
endprocedure;
enddefine;
define macro endexample;
'' -> ss_out;
charout -> cucharout;
;;; npr('example macro changed to check for store corruption');
;;; true -> popgctrace; sysgarbage();
exitfrom(n_call);
enddefine;
example +
1+4=>
** 5
endexample
/* Commented out since Prolog may not be loaded.
example is
:- X is 4+5, print('** '), print(X).
** 9
endexample
*/
/*
example -
;;; This shows a failure.
1-8 =>
** 9
endexample
*/
endsection;
|