[Date Prev] [Date Next] [Thread Prev] [Thread Next] Date Index Thread Index Search archive:
Date:Mon Jan 17 14:17:29 1995 
Subject:Re: justify code 
From: Robin Popplestone  
Volume-ID:950121.01 

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;