chiark - git - mdw - fringe/blob - algol68-fringe.a68

   1 COMMENT -*-a68-*-
   2
   3         Algol 68 implementation of a `same-fringe' solver.
   4
   5 COMMENT
   6 BEGIN
   7
   8 ###--------------------------------------------------------------------------
   9 # # Reporting errors.
  10 # #
  11 # # This stuff is specific to Algol 68 Genie.
  12 ###
  13
  14 [] CHAR program name =
  15   BEGIN [] CHAR prog = argv(3);
  16   INT i := UPB prog;
  17   WHILE (i >= LWB prog | prog[i] /= "/" | FALSE) DO i -:= 1 OD;
  18   prog[i + 1:]
  19   END;
  20
  21 PROC fail = ([] CHAR message) VOID:
  22   ### Mournfully announce an error and quit.
  23   #
  24   BEGIN put(stand error, (program name, ": ", message, new line));
  25     execve("/bin/false", "false", "die=now")    # Can this be any worse? #
  26   END;
  27
  28 ###--------------------------------------------------------------------------
  29 # # Nodes and trees.
  30 ###
  31
  32 MODE NODE = STRUCT (REF NODE left, right, CHAR data);
  33
  34 PROC tree is not empty = (REF NODE node) BOOL: node :/=: NIL;
  35
  36 PROC parse tree = ([] CHAR string) REF NODE:
  37   ### Parse STRING, and return the tree described.
  38   ##
  39   ## The syntax is simple:
  40   ##
  41   ##      tree ::= empty | `(' tree char tree `)'
  42   ##
  43   ## The amiguity is resolved by always treating `(' as a tree when a tree
  44   ## is expected.
  45   #
  46   BEGIN INT i := LWB string;
  47   PROC parse = REF NODE:
  48     BEGIN IF i > UPB string THEN NIL
  49       ELIF string[i] /= "(" THEN NIL
  50       ELSE i +:= 1;
  51         REF NODE left = parse;
  52         IF i > UPB string THEN fail("no data") FI;
  53         CHAR data = string[i]; i +:= 1;
  54         REF NODE right = parse;
  55         IF (i > UPB string | TRUE | string[i] /= ")")
  56           THEN fail("missing )") FI;
  57         i +:= 1;
  58         HEAP NODE := (left, right, data)
  59       FI
  60     END;
  61     REF NODE tree = parse;
  62     IF i <= UPB string THEN fail("trailing junk") FI;
  63     tree
  64   END;
  65
  66 ###--------------------------------------------------------------------------
  67 # # Iteration.
  68 ###
  69
  70 MODE NODEITER = STRUCT (REF [] REF NODE stack, INT sp);
  71
  72 PROC push nodes = (REF NODEITER iter, REF NODE node) VOID:
  73   ### Helper function for iteration.
  74   ##
  75   ## If NODE is not null, push it onto ITER's stack, and then do the same
  76   ## for NODE's left child.
  77   #
  78   BEGIN REF NODE n := node;
  79   WHILE tree is not empty(n)
  80     DO IF sp OF iter > UPB (stack OF iter)
  81       THEN INT max = UPB (stack OF iter);
  82         HEAP [2 * max] REF NODE new stack;
  83         FOR i FROM 1 TO max DO new stack[i] := (stack OF iter)[i] OD;
  84         stack OF iter := new stack
  85       FI;
  86       (stack OF iter)[sp OF iter] := n;
  87       n := left OF n;
  88       sp OF iter +:= 1
  89     OD
  90   END;
  91
  92 PROC next node = (REF NODEITER iter) REF NODE:
  93   ### Return the next node in order for the tree being traversed by ITER.
  94   ##
  95   ## Returns NIL if the iteration is complete.
  96   #
  97   IF sp OF iter = 1 THEN NIL
  98   ELSE sp OF iter -:= 1;
  99     REF NODE node = (stack OF iter)[sp OF iter];
 100     push nodes(iter, right OF node);
 101     node
 102   FI;
 103
 104 PROC node iterator = (REF NODE node) REF NODEITER:
 105   ### Return a new iterator traversing the tree rooted at NODE.
 106   #
 107   BEGIN REF NODEITER iter = HEAP NODEITER := (HEAP [1] REF NODE, 1);
 108   push nodes(iter, node);
 109   iter
 110   END;
 111
 112 ###--------------------------------------------------------------------------
 113 # # Fringe operations.
 114 ###
 115
 116 PROC print fringe = (REF NODE tree) VOID:
 117   ### Print the characters stored in the tree headed by TREE in order.
 118   #
 119   BEGIN REF NODEITER iter = node iterator(tree);
 120     WHILE REF NODE n = next node(iter); tree is not empty(n)
 121     DO print(data OF n) OD;
 122     print(new line)
 123   END;
 124
 125 PROC same fringes = (REF NODE n, REF NODE nn) BOOL:
 126   ### Answer whether traversing the trees rooted at N and NN yields the same
 127   ##  items in the same order.
 128   #
 129   BEGIN REF NODEITER i = node iterator(n), ii = node iterator(nn);
 130     BOOL win := FALSE;
 131     DO REF NODE n = next node(i), nn = next node(ii);
 132       IF tree is not empty(n)
 133       THEN IF tree is not empty(nn)
 134         THEN IF data OF n = data OF nn THEN SKIP ELSE done FI
 135         ELSE done
 136         FI
 137       ELIF tree is not empty(nn) THEN done
 138       ELSE win := TRUE; done
 139       FI
 140     OD;
 141   done: win
 142   END;
 143
 144 ###--------------------------------------------------------------------------
 145 # # Main program.
 146 # #
 147 # # Argument fetching is specific to Algol 68 Genie.
 148 ###
 149
 150 CASE argc - 3 IN
 151   BEGIN REF NODE tree = parse tree(argv(4));
 152     print fringe(tree)
 153   END,
 154   BEGIN REF NODE t = parse tree(argv(4)), tt = parse tree(argv(5));
 155     print(((same fringes(t, tt) | "match" | "no match"), new line))
 156   END
 157 OUT fail("bad args")
 158 ESAC
 159 END
 160
 161 ###----- That's all, folks -------------------------------------------------#