RIGAL/rigdos/BCOMP.RIG

-- Program BCOMP.RIG in directory \RIGAL
-- Compiles program written in Prof.Blikle small language
-- to PASCAL code.
#MAIN
$LIST:=#CALL_PAS(3 'EX1.TXT');
$TREE_CODE:=#analyse_program($LIST);
#GEN_PROGRAM($TREE_CODE);
##
%INCLUDE ANALYSE.RIG
#GEN_PROGRAM
 /#GEN_PROLOG() /
(. (* #GEN_STMT *) .)
 / #GEN_EPILOG() / ##

#GEN_PROLOG
/OPEN G 'ex1.pas';
 G<<' Program Main;';
 G<<' const tt=101;ff=102;err=103;';
 G<<' var state:record w,v,x,y,z:integer end;';
 G<<' function PLUS (a,b:integer) :integer;';
 G<<' begin if (a>100) or (b>100) then Plus:=err ';
 G<<'       else if a+b >100 then Plus:=err ';
 G<<'            else Plus:=a+b; end; ';
 G<<' function LESS (a,b:integer) :integer;';
 G<<' begin if (a>100) or (b>100) then Less:=err ';
 G<<'       else if a<b then Less:=tt ';
 G<<'            else Less:=ff; end; ';
 G<<' Procedure Val(a:integer);';
 G<<'  begin case a of ';
 G<<'   101 : writeln (''tt''); ';
 G<<'   102 : writeln (''ff''); ';
 G<<'   103 : writeln (''err''); ';
 G<<'   else  writeln (a);end;end; ';
 G<<' BEGIN WITH STATE DO BEGIN ';
 G<<'  w:=1;v:=1;x:=1;y:=1;z:=1; '/
 ##
 #GEN_EPILOG
  / G<<'Writeln ('' Post-DUMP : '');';
    G<<'Write (''w='');Val(w);';
    G<<'Write (''v='');Val(v);';
    G<<'Write (''x='');Val(x);';
    G<<'Write (''y='');Val(y);';
    G<<'Write (''z='');Val(z);';
    G<<'readln;end; ';
    G<<'END.'/
##
#GEN_STMT
 'assignment_op' ::
   <. left_part : $Id
        / G<< $Id ':=' /,
      right_part : #GEN_EXPR
        / G<] ';' / .>
;;
 'while_op'::
   <. condition :
         / G<<' WHILE ' /
         #GEN_EXPR
         / G<] '=tt DO BEGIN '/,
      body : (. (* #GEN_STMT *) .)
         / G<<'END;' / ,
      condition :
         / G<< ' IF ' /
         #GEN_EXPR
         / G<] ' =err THEN x:=err; ' /
  .>
##
#GEN_EXPR
 $N / G<] $N / ;;

 $Id / G<] $Id / ;;

 '+' :: <. arg1:
               / G<] ' PLUS( '/
               #GEN_EXPR,
           arg2:
               / G<] ',' /
               #GEN_EXPR
               / G<] ')' / .>
 ;;
 '<' :: <. arg1:
               / G<] ' LESS( '/
               #GEN_EXPR,
           arg2:
               / G<] ',' /
               #GEN_EXPR
               / G<] ')' / .>
 ##