home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / developm / language / elan.sit / cola / COLA.E next >
Encoding:
Text File  |  1988-11-09  |  9.0 KB  |  437 lines
  1.  
  2. cola interpreter:
  3.   # Robi in Blocksworld #
  4.   initialize interpreter;
  5.   program;
  6.   shutup interpreter.
  7.  
  8. PROC program:
  9.   clear command;
  10.   command part;
  11.   end command
  12. ENDPROC program;
  13.  
  14. PROC clear command:
  15.   must be both (clear symbol, newline symbol);
  16.   evaluate command (clear symbol)
  17. ENDPROC clear command;
  18.  
  19. PROC end command:
  20.   must be both (end symbol, newline symbol);
  21.   evaluate command (end symbol)
  22. ENDPROC end command;
  23.  
  24. PROC command part:
  25.   WHILE NOT ahead (end symbol)
  26.   REP command
  27.   ENDREP
  28. ENDPROC command part;
  29.  
  30. PROC command:
  31.   IF is (place symbol)
  32.   THEN should be place command
  33.   ELIF is (put symbol)
  34.   THEN should be put command
  35.   ELIF is (take symbol)
  36.   THEN should be take command
  37.   ELIF is (print symbol)
  38.   THEN should be print command
  39.   ELIF is (skip symbol)
  40.   THEN should be skip command
  41.   ELSE syntax error ("invalid command.")
  42.   FI
  43. ENDPROC command;
  44.  
  45. PROC should be print command:
  46.   IF found (newline symbol)
  47.   THEN
  48.     evaluate command (print symbol)
  49.   FI
  50. ENDPROC should be print command;
  51.  
  52. PROC should be skip command:
  53.   IF found (newline symbol)
  54.   THEN
  55.     read next line
  56.   FI
  57. ENDPROC should be skip command;
  58.  
  59. PROC should be place command:
  60.   TEXT CONST box :: HEAD current symbol;
  61.   IF found (square symbol, triangle symbol, circle symbol)
  62.   THEN
  63.     IF found (newline symbol)
  64.     THEN
  65.       evaluate command (place symbol, box)
  66.     FI
  67.   FI
  68. ENDPROC should be place command;
  69.  
  70. PROC should be put command:
  71.   TEXT CONST box1 :: HEAD current symbol;
  72.   IF found (square symbol, triangle symbol, circle symbol)
  73.   THEN
  74.     IF found (on symbol)
  75.     THEN
  76.       TEXT CONST box2 :: HEAD current symbol;
  77.       IF found (square symbol,
  78.                 triangle symbol, circle symbol)
  79.       THEN
  80.         IF found (newline symbol)
  81.         THEN
  82.           evaluate command (put symbol, box1, box2)
  83.         FI
  84.       FI
  85.     FI
  86.   FI
  87. ENDPROC should be put command;
  88.  
  89. PROC should be take command:
  90.   TEXT CONST box1 :: HEAD current symbol;
  91.   IF found (square symbol, triangle symbol, circle symbol)
  92.   THEN
  93.     IF is (off symbol)
  94.     THEN
  95.       IF found (newline symbol)
  96.       THEN
  97.         evaluate command (take symbol, box1)
  98.       FI
  99.     ELIF found (from symbol)
  100.     THEN
  101.       TEXT CONST box2 :: HEAD current symbol;
  102.       IF found (square symbol,
  103.                 triangle symbol, circle symbol)
  104.       THEN
  105.         IF found (newline symbol)
  106.         THEN
  107.           evaluate command (take symbol, box1, box2)
  108.         FI
  109.       FI
  110.     FI
  111.   FI
  112. ENDPROC should be take command;
  113.  
  114. initialize interpreter:
  115.   define symbols;
  116.   reserve space for representation;
  117.   initialize file operations;
  118.   read first line.
  119.  
  120. define symbols:
  121.   LET circle symbol = "CIRCLE";
  122.   LET clear symbol = "CLEAR";
  123.   LET end symbol = "END";
  124.   LET from symbol = "FROM";
  125.   LET newline symbol = "";
  126.   LET on symbol = "ON";
  127.   LET off symbol = "OFF";
  128.   LET place symbol = "PLACE";
  129.   LET print symbol = "PRINT";
  130.   LET put symbol = "PUT";
  131.   LET skip symbol = "";
  132.   LET square symbol = "SQUARE";
  133.   LET take symbol = "TAKE";
  134.   LET triangle symbol = "TRIANGLE".
  135.  
  136. reserve space for representation:
  137.   LET shelfsize = 8, maxheight = 6;
  138.   ROW shelfsize ROW maxheight TEXT VAR shelf;
  139.   ROW shelfsize INT VAR towerheight;
  140.   INT VAR i.
  141.  
  142. PROC evaluate command (TEXT CONST cmd, box):
  143.   IF cmd = place symbol
  144.   THEN evaluate place command
  145.   ELIF cmd = take symbol
  146.   THEN evaluate takeoff command
  147.   FI.
  148.  
  149. evaluate place command:
  150.   FOR i FROM 1 UPTO shelfsize
  151.   REP
  152.     IF towerheight [i] = 0
  153.     THEN
  154.       towerheight [i] INCR 1;
  155.       shelf [i] [towerheight [i]] := box;
  156.       read next line;
  157.       LEAVE evaluate place command
  158.     FI
  159.   ENDREP;
  160.   semantic error ("shelf full.").
  161.  
  162. evaluate takeoff command:
  163.   FOR i FROM 1 UPTO shelfsize
  164.   REP
  165.     IF towerheight [i] = 1
  166.     THEN
  167.       IF shelf [i] [1] = box
  168.       THEN
  169.         towerheight [i] := 0;
  170.         read next line;
  171.         LEAVE evaluate takeoff command
  172.       FI
  173.     FI
  174.   ENDREP;
  175.   semantic error ("no such box on the shelf.").
  176.  
  177. ENDPROC evaluate command;
  178.  
  179. PROC evaluate command (TEXT CONST cmd, box1, box2):
  180.   IF cmd = put symbol
  181.   THEN evaluate puton command
  182.   ELIF cmd = take symbol
  183.   THEN evaluate takefrom command
  184.   FI.
  185.  
  186. evaluate puton command:
  187.   IF box2 <> HEAD square symbol
  188.   THEN
  189.     semantic error ("base box is not a square.")
  190.   ELIF box1 = HEAD circle symbol
  191.   THEN
  192.     semantic error ("circle cannot be put on other box.")
  193.   ELIF proper box found
  194.   THEN
  195.     towerheight [i] INCR 1;
  196.     shelf [i] [towerheight [i]] := box1;
  197.     read next line
  198.   ELSE semantic error ("no such box.")
  199.   FI.
  200.  
  201. proper box found:
  202.   FOR i FROM 1 UPTO shelfsize
  203.   REP
  204.     IF towerheight [i] > 0 AND towerheight [i] < maxheight
  205.     THEN
  206.       IF shelf [i] [towerheight [i]] = box2
  207.       THEN
  208.         LEAVE proper box found WITH true
  209.       FI
  210.     FI
  211.   ENDREP;
  212.   false.
  213.  
  214. evaluate takefrom command:
  215.   IF box2 <> HEAD square symbol
  216.   THEN
  217.     semantic error ("base box is not a square.")
  218.   ELIF proper box pair found
  219.   THEN
  220.     towerheight [i] DECR 1;
  221.     read next line
  222.   ELSE
  223.     semantic error ("no such box.")
  224.   FI.
  225.  
  226. proper box pair found:
  227.   FOR i FROM 1 UPTO shelfsize
  228.   REP
  229.     IF towerheight [i] > 1
  230.     THEN
  231.       IF shelf [i] [towerheight [i]] = box1 AND
  232.          shelf [i] [towerheight [i] - 1] = box2
  233.       THEN
  234.         LEAVE proper box pair found WITH true
  235.       FI
  236.     FI
  237.   ENDREP;
  238.   false.
  239.  
  240. ENDPROC evaluate command;
  241.  
  242. PROC evaluate command (TEXT CONST cmd):
  243.   IF cmd = clear symbol
  244.   THEN evaluate clear command
  245.   ELIF cmd = print symbol
  246.   THEN evaluate print command
  247.   ELIF cmd = end symbol
  248.   THEN evaluate end command
  249.   FI.
  250.  
  251. evaluate clear command:
  252.   FOR i FROM 1 UPTO shelfsize
  253.   REP towerheight [i] := 0
  254.   ENDREP;
  255.   read next line.
  256.  
  257. evaluate print command:
  258.   print world;
  259.   read next line.
  260.  
  261. print world:
  262.   line;
  263.   INT VAR j;
  264.   FOR j FROM maxheight DOWNTO 1
  265.   REP
  266.     FOR i FROM 1 UPTO shelfsize
  267.     REP
  268.       IF towerheight [i] < j
  269.       THEN
  270.         put (2 * " ")
  271.       ELSE
  272.         put (shelf [i] [j] + " ")
  273.       FI
  274.     ENDREP;
  275.     line
  276.   ENDREP;
  277.   put ((2 * shelfsize - 1) * "-").
  278.  
  279. evaluate end command:
  280.   .
  281.  
  282. ENDPROC evaluate command;
  283.  
  284. initialize file operations:
  285.   TEXT VAR infile name :: "robi.cla",
  286.            outfile name :: "robi.cla";
  287.   BOOL VAR infile opened :: false,
  288.            outfile opened :: false;
  289.   put ("Input from file: ");
  290.   edit (infile name, 1);
  291.   IF infile name <> ""
  292.   THEN
  293.     old file (infile name);
  294.     infile opened := true
  295.   FI;
  296.   line;
  297.   put ("Output to file: ");
  298.   edit (outfile name, 1);
  299.   IF outfile name <> "" AND outfile name <> infile name
  300.   THEN
  301.     new file (outfile name);
  302.     outfile opened := true
  303.   FI.
  304.  
  305. read first line:
  306.   TEXT VAR current line :: "";
  307.   INT VAR topos :: 0, charpos;
  308.   TEXT VAR current symbol;
  309.   read next line.
  310.  
  311. PROC read next line:
  312.   write line (current line);
  313.   read a line;
  314.   topos := 0;
  315.   read next symbol.
  316.  
  317. read a line:
  318.   IF infile opened
  319.   THEN read a line from file
  320.   ELSE read a line from keyboard
  321.   FI.
  322.  
  323. read a line from file:
  324.   WHILE NOT file ended
  325.   REP
  326.     read (current line);
  327.     current line := compress (current line)
  328.   UNTIL current line <> ""
  329.   ENDREP;
  330.   line;
  331.   put (current line).
  332.  
  333. read a line from keyboard:
  334.   line;
  335.   put ("Next cmd, please: ");
  336.   REP
  337.     edit (current line, 1);
  338.     current line := compress (current line)
  339.   UNTIL current line <> ""
  340.   ENDREP.
  341.  
  342. ENDPROC read next line;
  343.  
  344. PROC write line (TEXT CONST t):
  345.   IF outfile opened
  346.   THEN
  347.     write (t);
  348.     write line
  349.   FI
  350. ENDPROC write line;
  351.  
  352. PROC read next symbol:
  353.   charpos := topos + 1;
  354.   skip leading spaces;
  355.   topos := pos (current line, " ", charpos + 1);
  356.   IF topos <= charpos
  357.   THEN topos := LENGTH current line + 1
  358.   FI;
  359.   current symbol :=
  360.           subtext (current line, charpos, topos - 1).
  361.  
  362.   skip leading spaces:
  363.     WHILE (current line SUB charpos) = " "
  364.     REP charpos INCR 1
  365.     ENDREP.
  366.  
  367. ENDPROC read next symbol;
  368.  
  369. shutup interpreter:
  370.   write line (current line);
  371.   close file.
  372.  
  373. PROC syntax error (TEXT CONST message):
  374.   offer line for editing (charpos, "Syntax: " + message)
  375. ENDPROC syntax error;
  376.  
  377. PROC semantic error (TEXT CONST message):
  378.   offer line for editing (charpos, "Semantics: " + message)
  379. ENDPROC semantic error;
  380.  
  381. PROC offer line for editing (INT CONST errpos,
  382.                              TEXT CONST message):
  383.   line;
  384.   put (message);
  385.   line;
  386.   put ("   Edit, please: ");
  387.   charpos := 1;
  388.   topos := charpos - 1;
  389.   edit (current line, errpos, charpos, ""13"");
  390.   current line := compress (current line);
  391.   read next symbol
  392. ENDPROC offer line for editing;
  393.  
  394. BOOL PROC ahead (TEXT CONST sym):
  395.   current symbol = sym
  396. ENDPROC ahead;
  397.  
  398. BOOL PROC is (TEXT CONST sym):
  399.   IF ahead (sym)
  400.   THEN
  401.     read next symbol;
  402.     true
  403.   ELSE
  404.     false
  405.   FI
  406. ENDPROC is;
  407.  
  408. PROC must be both (TEXT CONST sym1, sym2):
  409.   WHILE NOT (is (sym1) AND is (sym2))
  410.   REP
  411.     syntax error (sym1 + " " + sym2 + " ?");
  412.   ENDREP
  413. ENDPROC must be both;
  414.  
  415. BOOL PROC found (TEXT CONST sym1, sym2, sym3):
  416.   IF ahead (sym1) OR ahead (sym2) OR ahead (sym3)
  417.   THEN
  418.     read next symbol;
  419.     true
  420.   ELSE
  421.     syntax error (sym1 + " " + sym2 + " " + sym3 + " ?");
  422.     false
  423.   FI
  424. ENDPROC found;
  425.  
  426. BOOL PROC found (TEXT CONST sym):
  427.   IF ahead (sym)
  428.   THEN
  429.     read next symbol;
  430.     true
  431.   ELSE
  432.     syntax error (sym + " ?");
  433.     false
  434.   FI
  435. ENDPROC found;
  436.  
  437.