home *** CD-ROM | disk | FTP | other *** search
-
- PROC should be put command:
- TEXT CONST box1 :: HEAD current symbol;
- IF found (square symbol, triangle symbol)
- THEN
- IF found (on symbol)
- THEN
- TEXT CONST box2 :: HEAD current symbol;
- IF found (square symbol)
- THEN
- IF found (newline symbol)
- THEN evaluate command (put symbol, box1, box2)
- FI
- FI
- FI
- FI
- ENDPROC should be put command;
-
- PROC evaluate command (TEXT CONST cmd, box1, box2):
- IF cmd = put symbol
- THEN evaluate puton command
- ELIF cmd = take symbol
- THEN evaluate takefrom command
- FI.
-
- evaluate puton command:
- IF proper box found
- THEN
- towerheight [i] INCR 1;
- shelf [i] [towerheight [i]] := box1;
- read next line
- ELSE semantic error ("no such box.")
- FI.
-
- proper box found:
- FOR i FROM 1 UPTO shelfsize
- REP
- IF towerheight [i] > 0 AND towerheight [i] < maxheight
- THEN
- IF shelf [i] [towerheight [i]] = box2
- THEN
- LEAVE proper box found WITH true
- FI
- FI
- ENDREP;
- false.
-
- evaluate takefrom command:
- IF box2 <> HEAD square symbol
- THEN
- semantic error ("base box is not a square.")
- ELIF proper box pair found
- THEN
- towerheight [i] DECR 1;
- read next line
- ELSE
- semantic error ("no such box.")
- FI.
-
- proper box pair found:
- FOR i FROM 1 UPTO shelfsize
- REP
- IF towerheight [i] > 1
- THEN
- IF shelf [i] [towerheight [i]] = box1 AND
- shelf [i] [towerheight [i] - 1] = box2
- THEN
- LEAVE proper box pair found WITH true
- FI
- FI
- ENDREP;
- false.
-
- ENDPROC evaluate command;
-
- BOOL PROC found (TEXT CONST sym1, sym2):
- IF ahead (sym1) OR ahead (sym2)
- THEN
- read next symbol;
- true
- ELSE
- syntax error (sym1 + " " + sym2 + " ?");
- false
- FI
- ENDPROC found;
-
-