| 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 -------------------------------------------------# |