BEGIN

% These are headers for functions defined in "argv.c" %

INTEGER PROCEDURE argc;
   FORTRAN "get_argc";

STRING(100) PROCEDURE argv (INTEGER VALUE index);
   FORTRAN "get_argv";

INTEGER PROCEDURE argv_len (INTEGER VALUE index);
   FORTRAN "get_argv_length";

PROCEDURE exit (INTEGER VALUE code);
   FORTRAN "do_exit";

PROCEDURE stderr;
   IOCONTROL(50001);  % redirect output to stderr (an Awe extension) %


% NOTE: Algol W uses ECBDIC character codes! %

BOOLEAN PROCEDURE is_letter(STRING(1) VALUE c);
   c >= "a" AND c <= "i" OR
   c >= "j" AND c <= "r" OR
   c >= "s" AND c <= "z" OR
   c >= "A" AND c <= "I" OR
   c >= "J" AND c <= "R" OR
   c >= "S" AND c <= "Z";

BOOLEAN PROCEDURE is_space(STRING(1) VALUE c);
   c = " " OR c = CODE(5) OR c = CODE(37); 


PROCEDURE compile(STRING(100) VALUE expression; INTEGER VALUE expression_len;
                  STRING(100) RESULT rpn; INTEGER RESULT rpn_len);
COMMENT
   Compiles a predicate (a boolean expression) into 'reverse Polish notation'.
   The RPN uses the one-character variants of the symbols;
BEGIN
   INTEGER cursor, position;
   STRING(1) dummy, next;

   PROCEDURE error(STRING(30) VALUE message);
   BEGIN
      stderr;
      WRITE(" ", expression);
      WRITE(" ");
      FOR i := 1 UNTIL position DO WRITEON(" ");
      WRITEON("^ ", message);
      exit(1)
   END;

   PROCEDURE get_next;  % The lexer. %
   BEGIN
      PROCEDURE expect (STRING(1) VALUE c);
      BEGIN
         cursor := cursor + 1;
         IF cursor >= expression_len OR expression(cursor|1) ~= c THEN
            BEGIN position := cursor; error("unexpected character") END
      END;
      
      WHILE cursor <= expression_len AND is_space(expression(cursor|1)) DO
         cursor := cursor + 1;
      position := cursor;
      IF cursor > expression_len THEN
         next := CODE(0)
      ELSE BEGIN
         STRING(1) c;
         c := expression(cursor|1);
         next := IF      c = "F" THEN "0"
                 ELSE IF c = "T" THEN "1"
                 ELSE IF c = "-" THEN BEGIN expect(">"); ">" END
                 ELSE IF c = "<" THEN BEGIN expect("-"); expect(">"); "=" END
                 ELSE IF c = "\" THEN BEGIN expect("/"); "+" END
                 ELSE IF c = "/" THEN BEGIN expect("\"); "." END
                 ELSE c;
         cursor := cursor + 1
      END
   END get_next;
   
   BOOLEAN PROCEDURE match(STRING(1) VALUE c);
      IF next = c THEN
         BEGIN get_next; TRUE END
      ELSE
         FALSE;

   PROCEDURE add(STRING(1) VALUE C);
   BEGIN
      rpn(rpn_len|1) := c;
      rpn_len := rpn_len + 1
   END add;
   
   % The parser: %
   PROCEDURE l0; BEGIN l1; add(","); WHILE match(",") DO BEGIN l1; add(",") END END;
   PROCEDURE l1; BEGIN l2; WHILE match("=") DO BEGIN l2; add("=") END END;
   PROCEDURE l2; BEGIN l3; WHILE match(">") DO BEGIN l3; add(">") END END;
   PROCEDURE l3; BEGIN l4; WHILE match("@") DO BEGIN l4; add("@") END END;
   PROCEDURE l4; BEGIN l5; WHILE match("+") DO BEGIN l5; add("+") END END;
   PROCEDURE l5; BEGIN l6; WHILE match(".") DO BEGIN l6; add(".") END END;
   PROCEDURE l6;
      IF match("~") THEN
         BEGIN l6; add("~") END
      ELSE IF match("(") THEN
         BEGIN l1; IF NOT match(")") THEN error("expected a )") END
      ELSE IF next = "0" OR next = "1" OR is_letter(next) THEN
         BEGIN add(next); get_next END
      ELSE
         error("syntax error");

   rpn := " ";
   rpn_len := 0;
   cursor := 0;
   get_next;
   l0;
   IF next ~= CODE(0) THEN error("syntax error")
END compile;

 

PROCEDURE run(STRING(100) VALUE expression; INTEGER VALUE expression_len;
              STRING(100) VALUE rpn;   INTEGER VALUE rpn_len;
              BOOLEAN VALUE test);
BEGIN
   BOOLEAN ARRAY truth_values (DECODE("a") :: DECODE("Z"));

   STRING(20) variables;
   INTEGER variables_len;
   
   PROCEDURE set_variables (INTEGER VALUE minterm);
   COMMENT
      Set the variables' values to the bits of the binary number 'minterm';
   BEGIN
      FOR i := variables_len-1 STEP -1 UNTIL 0 DO BEGIN
         truth_values(DECODE(variables(i|1))) := odd(minterm);
         minterm := minterm DIV 2
      END
   END set_variables;

   PROCEDURE interpret;
   COMMENT
       Print the right hand side of a row of the table by
       interpreting the RPN program on a stack machine;
   BEGIN
      BOOLEAN ARRAY stack (1::100);
      INTEGER top;
      top := 0; 
      FOR i := 0 UNTIL rpn_len-1 DO BEGIN
         STRING(1) c;
         c := rpn(i|1);
         IF c = "." THEN
            BEGIN stack(top-1) := stack(top-1) and stack(top); top := top - 1 END
         ELSE IF c = "+" THEN
            BEGIN stack(top-1) := stack(top-1) OR stack(top); top := top - 1 END
         ELSE IF c = "@" THEN
            BEGIN stack(top-1) := stack(top-1) ~= stack(top); top := top - 1 END
         ELSE IF c = "=" THEN
            BEGIN stack(top-1) := stack(top-1) = stack(top); top := top - 1 END
         ELSE IF c = ">" THEN
            BEGIN stack(top-1) := NOT stack(top-1) OR stack(top); top := top - 1 END
         ELSE IF c = "~" THEN
            BEGIN stack(top) := NOT stack(top) END
         ELSE IF c = "0" THEN
            BEGIN top := top + 1; stack(top) := FALSE  END
         ELSE IF c = "1" THEN
            BEGIN top := top + 1; stack(top) := TRUE END
         ELSE IF is_letter(c) THEN
            BEGIN top := top + 1; stack(top) := truth_values(DECODE(c)) END
         ELSE IF c = "," AND test THEN
            BEGIN
               IF ~stack(top) THEN BEGIN WRITE(stderr, "Failed:", expression); exit(1) END;
               top := top - 1
            END
         ELSE IF c = "," THEN
            BEGIN WRITEON(" ", IF stack(top) THEN "1" ELSE "0"); top := top - 1 END
         ELSE
            ASSERT FALSE
      END
   END interpret;

   % Make a list of the variables used in 'rpn' %
   variables_len := 0;
   FOR i := 0 UNTIL rpn_len-1 DO BEGIN
      STRING(1) c;
      c := rpn(i|1);
      IF is_letter(c) THEN BEGIN
         FOR j := 0 UNTIL variables_len-1 DO
            IF c = variables(j|1) THEN GOTO continue_i;
         variables(variables_len|1) := c;
         variables_len := variables_len + 1
      END;
   continue_i:
   END;

   IF test THEN BEGIN
      FOR minterm := 0 UNTIL NUMBER(#1 SHL variables_len) - 1 DO BEGIN
         set_variables(minterm);
         interpret
      END;
   END
   ELSE BEGIN  % print a table %
      WRITE(" ");
      WRITE(" ");
      FOR i := 0 UNTIL variables_len-1 DO WRITEON(" ", variables(i|1));
      WRITEON(" | ", expression);
      
      FOR minterm := 0 UNTIL NUMBER(#1 SHL variables_len) - 1 DO BEGIN
         WRITE(" ");
         
         set_variables(minterm);
   
         FOR i := 0 UNTIL variables_len-1 DO
            WRITEON(" ", IF truth_values(DECODE(variables(i|1))) THEN "1" ELSE "0");
         WRITEON(" |");
   
         interpret;
      END;
      
      WRITE(" ")
   END
END run;


PROCEDURE main;
BEGIN
   STRING(100) expression, rpn;
   INTEGER expression_len, rpn_len;
   IF argc = 2 THEN BEGIN
      expression := argv(1);
      expression_len := argv_len(1);
      compile(expression, expression_len, rpn, rpn_len);
      run(expression, expression_len, rpn, rpn_len, FALSE)
   END
   ELSE IF argc = 3 AND argv(1) = "-t" THEN BEGIN
      expression := argv(2);
      expression_len := argv_len(2);
      compile(expression, expression_len, rpn, rpn_len);
      run(expression, expression_len, rpn, rpn_len, TRUE)
   END
   ELSE BEGIN
      WRITE(stderr, "usage: logic [-t] 'expression'");
      exit(1)
   END
END main;

main
END.
