Compiler/AST interpreter: Difference between revisions
Content added Content deleted
(Added Forth implementation) |
(Add COBOL) |
||
Line 742: | Line 742: | ||
</pre> |
</pre> |
||
</b> |
</b> |
||
=={{header|COBOL}}== |
|||
Code by Steve Williams. Tested with GnuCOBOL 2.2. |
|||
<lang cobol> >>SOURCE FORMAT IS FREE |
|||
identification division. |
|||
*> this code is dedicated to the public domain |
|||
*> (GnuCOBOL) 2.3-dev.0 |
|||
program-id. astinterpreter. |
|||
environment division. |
|||
configuration section. |
|||
repository. function all intrinsic. |
|||
data division. |
|||
working-storage section. |
|||
01 program-name pic x(32) value spaces global. |
|||
01 input-name pic x(32) value spaces global. |
|||
01 input-status pic xx global. |
|||
01 ast-record global. |
|||
03 ast-type pic x(14). |
|||
03 ast-value pic x(48). |
|||
03 filler redefines ast-value. |
|||
05 asl-left pic 999. |
|||
05 asl-right pic 999. |
|||
01 error-record pic x(64) value spaces global. |
|||
01 loadstack global. |
|||
03 l pic 99 value 0. |
|||
03 l-lim pic 99 value 64. |
|||
03 load-entry occurs 64. |
|||
05 l-node pic x(14). |
|||
05 l-left pic 999. |
|||
05 l-right pic 999. |
|||
05 l-link pic 999. |
|||
01 abstract-syntax-tree global. |
|||
03 t pic 999 value 0. |
|||
03 t1 pic 999. |
|||
03 n1 pic 999. |
|||
03 t-lim pic 999 value 998. |
|||
03 filler occurs 998. |
|||
05 leaf. |
|||
07 leaf-type pic x(14). |
|||
07 leaf-value pic x(48). |
|||
05 node redefines leaf. |
|||
07 node-type pic x(14). |
|||
07 node-left pic 999. |
|||
07 node-right pic 999. |
|||
01 interpreterstack global. |
|||
03 stack1 pic 99 value 2. |
|||
03 stack2 pic 99 value 1. |
|||
03 stack-lim pic 99 value 32. |
|||
03 stack-entry occurs 32. |
|||
05 stack-source pic 99. |
|||
05 stack usage binary-int. |
|||
01 variables global. |
|||
03 v pic 99. |
|||
03 v-max pic 99 value 0. |
|||
03 v-lim pic 99 value 16. |
|||
03 filler occurs 16. |
|||
05 variable-value binary-int. |
|||
05 variable-name pic x(48). |
|||
01 strings global. |
|||
03 s pic 99. |
|||
03 s-max pic 99 value 0. |
|||
03 s-lim pic 99 value 16. |
|||
03 filler occurs 16 value spaces. |
|||
05 string-value pic x(48). |
|||
01 string-fields global. |
|||
03 string-length pic 99. |
|||
03 string1 pic 99. |
|||
03 length1 pic 99. |
|||
03 count1 pic 99. |
|||
01 display-fields global. |
|||
03 display-number pic -(9)9. |
|||
03 display-pending pic x value 'n'. |
|||
03 character-value. |
|||
05 character-number usage binary-char. |
|||
procedure division chaining program-name. |
|||
start-astinterpreter. |
|||
call 'loadast' |
|||
if program-name <> spaces |
|||
call 'readinput' *> close the input-file |
|||
end-if |
|||
>>d perform print-ast |
|||
call 'runast' using t |
|||
if display-pending = 'y' |
|||
display space |
|||
end-if |
|||
stop run |
|||
. |
|||
print-ast. |
|||
call 'printast' using t |
|||
display 'ast:' upon syserr |
|||
display 't=' t |
|||
perform varying t1 from 1 by 1 until t1 > t |
|||
if leaf-type(t1) = 'Identifier' or 'Integer' or 'String' |
|||
display t1 space trim(leaf-type(t1)) space trim(leaf-value(t1)) upon syserr |
|||
else |
|||
display t1 space node-left(t1) space node-right(t1) space trim(node-type(t1)) |
|||
upon syserr |
|||
end-if |
|||
end-perform |
|||
. |
|||
identification division. |
|||
program-id. runast common recursive. |
|||
data division. |
|||
working-storage section. |
|||
01 word-length constant as length of binary-int. |
|||
linkage section. |
|||
01 n pic 999. |
|||
procedure division using n. |
|||
start-runast. |
|||
if n = 0 |
|||
exit program |
|||
end-if |
|||
evaluate node-type(n) |
|||
when 'Integer' |
|||
perform push-stack |
|||
move numval(leaf-value(n)) to stack(stack1) |
|||
when 'Identifier' |
|||
perform get-variable-index |
|||
perform push-stack |
|||
move v to stack-source(stack1) |
|||
move variable-value(v) to stack(stack1) |
|||
when 'String' |
|||
perform get-string-index |
|||
perform push-stack |
|||
move s to stack-source(stack1) |
|||
when 'Assign' |
|||
call 'runast' using node-left(n) |
|||
call 'runast' using node-right(n) |
|||
move stack-source(stack2) to v |
|||
move stack(stack1) to variable-value(v) |
|||
perform pop-stack |
|||
perform pop-stack |
|||
when 'If' |
|||
call 'runast' using node-left(n) |
|||
move node-right(n) to n1 |
|||
if stack(stack1) <> 0 |
|||
call 'runast' using node-left(n1) |
|||
else |
|||
call 'runast' using node-right(n1) |
|||
end-if |
|||
perform pop-stack |
|||
when 'While' |
|||
call 'runast' using node-left(n) |
|||
perform until stack(stack1) = 0 |
|||
perform pop-stack |
|||
call 'runast' using node-right(n) |
|||
call 'runast' using node-left(n) |
|||
end-perform |
|||
perform pop-stack |
|||
when 'Add' |
|||
perform get-values |
|||
add stack(stack1) to stack(stack2) |
|||
perform pop-stack |
|||
when 'Subtract' |
|||
perform get-values |
|||
subtract stack(stack1) from stack(stack2) |
|||
perform pop-stack |
|||
when 'Multiply' |
|||
perform get-values |
|||
multiply stack(stack1) by stack(stack2) |
|||
perform pop-stack |
|||
when 'Divide' |
|||
perform get-values |
|||
divide stack(stack1) into stack(stack2) |
|||
perform pop-stack |
|||
when 'Mod' |
|||
perform get-values |
|||
move mod(stack(stack2),stack(stack1)) to stack(stack2) |
|||
perform pop-stack |
|||
when 'Less' |
|||
perform get-values |
|||
if stack(stack2) < stack(stack1) |
|||
move 1 to stack(stack2) |
|||
else |
|||
move 0 to stack(stack2) |
|||
end-if |
|||
perform pop-stack |
|||
when 'Greater' |
|||
perform get-values |
|||
if stack(stack2) > stack(stack1) |
|||
move 1 to stack(stack2) |
|||
else |
|||
move 0 to stack(stack2) |
|||
end-if |
|||
perform pop-stack |
|||
when 'LessEqual' |
|||
perform get-values |
|||
if stack(stack2) <= stack(stack1) |
|||
move 1 to stack(stack2) |
|||
else |
|||
move 0 to stack(stack2) |
|||
end-if |
|||
perform pop-stack |
|||
when 'GreaterEqual' |
|||
perform get-values |
|||
if stack(stack2) >= stack(stack1) |
|||
move 1 to stack(stack2) |
|||
else |
|||
move 0 to stack(stack2) |
|||
end-if |
|||
perform pop-stack |
|||
when 'Equal' |
|||
perform get-values |
|||
if stack(stack2) = stack(stack1) |
|||
move 1 to stack(stack2) |
|||
else |
|||
move 0 to stack(stack2) |
|||
end-if |
|||
perform pop-stack |
|||
when 'NotEqual' |
|||
perform get-values |
|||
if stack(stack2) <> stack(stack1) |
|||
move 1 to stack(stack2) |
|||
else |
|||
move 0 to stack(stack2) |
|||
end-if |
|||
perform pop-stack |
|||
when 'And' |
|||
perform get-values |
|||
call "CBL_AND" using stack(stack1) stack(stack2) by value word-length |
|||
perform pop-stack |
|||
when 'Or' |
|||
perform get-values |
|||
call "CBL_OR" using stack(stack1) stack(stack2) by value word-length |
|||
perform pop-stack |
|||
when 'Not' |
|||
call 'runast' using node-left(n) |
|||
if stack(stack1) = 0 |
|||
move 1 to stack(stack1) |
|||
else |
|||
move 0 to stack(stack1) |
|||
end-if |
|||
when 'Negate' |
|||
call 'runast' using node-left(n) |
|||
compute stack(stack1) = - stack(stack1) |
|||
when 'Prtc' |
|||
call 'runast' using node-left(n) |
|||
move stack(stack1) to character-number |
|||
display character-value with no advancing |
|||
move 'y' to display-pending |
|||
perform pop-stack |
|||
when 'Prti' |
|||
call 'runast' using node-left(n) |
|||
move stack(stack1) to display-number |
|||
display trim(display-number) with no advancing |
|||
move 'y' to display-pending |
|||
perform pop-stack |
|||
when 'Prts' |
|||
call 'runast' using node-left(n) |
|||
move stack-source(stack1) to s |
|||
move length(trim(string-value(s))) to string-length |
|||
move 2 to string1 |
|||
compute length1 = string-length - 2 |
|||
perform until string1 >= string-length |
|||
move 0 to count1 |
|||
inspect string-value(s)(string1:length1) |
|||
tallying count1 for characters before initial '\' *> ' (workaround Rosetta Code highlighter problem) |
|||
evaluate true |
|||
when string-value(s)(string1 + count1 + 1:1) = 'n' *> \n |
|||
display string-value(s)(string1:count1) |
|||
move 'n' to display-pending |
|||
compute string1 = string1 + 2 + count1 |
|||
compute length1 = length1 - 2 - count1 |
|||
when string-value(s)(string1 + count1 + 1:1) = '\' *> \\ ' |
|||
display string-value(s)(string1:count1 + 1) with no advancing |
|||
move 'y' to display-pending |
|||
compute string1 = string1 + 2 + count1 |
|||
compute length1 = length1 - 2 - count1 |
|||
when other |
|||
display string-value(s)(string1:count1) with no advancing |
|||
move 'y' to display-pending |
|||
add count1 to string1 |
|||
subtract count1 from length1 |
|||
end-evaluate |
|||
end-perform |
|||
perform pop-stack |
|||
when 'Sequence' |
|||
call 'runast' using node-left(n) |
|||
call 'runast' using node-right(n) |
|||
when other |
|||
string 'in astinterpreter unknown node type ' node-type(n) into error-record |
|||
call 'reporterror' |
|||
end-evaluate |
|||
exit program |
|||
. |
|||
push-stack. |
|||
if stack1 >= s-lim |
|||
string 'in astinterpreter at ' n ' stack overflow' into error-record |
|||
call 'reporterror' |
|||
end-if |
|||
add 1 to stack1 stack2 |
|||
initialize stack-entry(stack1) |
|||
. |
|||
pop-stack. |
|||
if stack1 < 2 |
|||
string 'in astinterpreter at ' n ' stack underflow ' into error-record |
|||
call 'reporterror' |
|||
end-if |
|||
subtract 1 from stack1 stack2 |
|||
. |
|||
get-variable-index. |
|||
perform varying v from 1 by 1 until v > v-max |
|||
or variable-name(v) = leaf-value(n) |
|||
continue |
|||
end-perform |
|||
if v > v-max |
|||
if v-max = v-lim |
|||
string 'in astinterpreter number of variables exceeds ' v-lim into error-record |
|||
call 'reporterror' |
|||
end-if |
|||
move v to v-max |
|||
move leaf-value(n) to variable-name(v) |
|||
move 0 to variable-value(v) |
|||
end-if |
|||
. |
|||
get-string-index. |
|||
perform varying s from 1 by 1 until s > s-max |
|||
or string-value(s) = leaf-value(n) |
|||
continue |
|||
end-perform |
|||
if s > s-max |
|||
if s-max = s-lim |
|||
string 'in astinterpreter number of strings exceeds ' s-lim into error-record |
|||
call 'reporterror' |
|||
end-if |
|||
move s to s-max |
|||
move leaf-value(n) to string-value(s) |
|||
end-if |
|||
. |
|||
get-values. |
|||
call 'runast' using node-left(n) |
|||
call 'runast' using node-right(n) |
|||
. |
|||
end program runast. |
|||
identification division. |
|||
program-id. loadast common recursive. |
|||
procedure division. |
|||
start-loadast. |
|||
if l >= l-lim |
|||
string 'in astinterpreter loadast l exceeds ' l-lim into error-record |
|||
call 'reporterror' |
|||
end-if |
|||
add 1 to l |
|||
call 'readinput' |
|||
evaluate true |
|||
when ast-record = ';' |
|||
when input-status = '10' |
|||
move 0 to return-code |
|||
when ast-type = 'Identifier' |
|||
when ast-type = 'Integer' |
|||
when ast-type = 'String' |
|||
call 'makeleaf' using ast-type ast-value |
|||
move t to return-code |
|||
when ast-type = 'Sequence' |
|||
move ast-type to l-node(l) |
|||
call 'loadast' |
|||
move return-code to l-left(l) |
|||
call 'loadast' |
|||
move t to l-right(l) |
|||
call 'makenode' using l-node(l) l-left(l) l-right(l) |
|||
move t to return-code |
|||
when other |
|||
move ast-type to l-node(l) |
|||
call 'loadast' |
|||
move return-code to l-left(l) |
|||
call 'loadast' |
|||
move return-code to l-right(l) |
|||
call 'makenode' using l-node(l) l-left(l) l-right(l) |
|||
move t to return-code |
|||
end-evaluate |
|||
subtract 1 from l |
|||
. |
|||
end program loadast. |
|||
identification division. |
|||
program-id. makenode common. |
|||
data division. |
|||
linkage section. |
|||
01 parm-type any length. |
|||
01 parm-l-left pic 999. |
|||
01 parm-l-right pic 999. |
|||
procedure division using parm-type parm-l-left parm-l-right. |
|||
start-makenode. |
|||
if t >= t-lim |
|||
string 'in astinterpreter makenode t exceeds ' t-lim into error-record |
|||
call 'reporterror' |
|||
end-if |
|||
add 1 to t |
|||
move parm-type to node-type(t) |
|||
move parm-l-left to node-left(t) |
|||
move parm-l-right to node-right(t) |
|||
. |
|||
end program makenode. |
|||
identification division. |
|||
program-id. makeleaf common. |
|||
data division. |
|||
linkage section. |
|||
01 parm-type any length. |
|||
01 parm-value pic x(48). |
|||
procedure division using parm-type parm-value. |
|||
start-makeleaf. |
|||
add 1 to t |
|||
if t >= t-lim |
|||
string 'in astinterpreter makeleaf t exceeds ' t-lim into error-record |
|||
call 'reporterror' |
|||
end-if |
|||
move parm-type to leaf-type(t) |
|||
move parm-value to leaf-value(t) |
|||
. |
|||
end program makeleaf. |
|||
identification division. |
|||
program-id. printast common recursive. |
|||
data division. |
|||
linkage section. |
|||
01 n pic 999. |
|||
procedure division using n. |
|||
start-printast. |
|||
if n = 0 |
|||
display ';' upon syserr |
|||
exit program |
|||
end-if |
|||
display leaf-type(n) upon syserr |
|||
evaluate leaf-type(n) |
|||
when 'Identifier' |
|||
when 'Integer' |
|||
when 'String' |
|||
display leaf-type(n) space trim(leaf-value(n)) upon syserr |
|||
when other |
|||
display node-type(n) upon syserr |
|||
call 'printast' using node-left(n) |
|||
call 'printast' using node-right(n) |
|||
end-evaluate |
|||
. |
|||
end program printast. |
|||
identification division. |
|||
program-id. readinput common. |
|||
environment division. |
|||
input-output section. |
|||
file-control. |
|||
select input-file assign using input-name |
|||
status is input-status |
|||
organization is line sequential. |
|||
data division. |
|||
file section. |
|||
fd input-file. |
|||
01 input-record pic x(64). |
|||
procedure division. |
|||
start-readinput. |
|||
if program-name = spaces |
|||
move '00' to input-status |
|||
accept ast-record on exception move '10' to input-status end-accept |
|||
exit program |
|||
end-if |
|||
if input-name = spaces |
|||
string program-name delimited by space '.ast' into input-name |
|||
open input input-file |
|||
if input-status = '35' |
|||
string 'in astinterpreter ' trim(input-name) ' not found' into error-record |
|||
call 'reporterror' |
|||
end-if |
|||
end-if |
|||
read input-file into ast-record |
|||
evaluate input-status |
|||
when '00' |
|||
continue |
|||
when '10' |
|||
close input-file |
|||
when other |
|||
string 'in astinterpreter ' trim(input-name) ' unexpected input-status: ' input-status |
|||
into error-record |
|||
call 'reporterror' |
|||
end-evaluate |
|||
. |
|||
end program readinput. |
|||
program-id. reporterror common. |
|||
procedure division. |
|||
start-reporterror. |
|||
report-error. |
|||
display error-record upon syserr |
|||
stop run with error status -1 |
|||
. |
|||
end program reporterror. |
|||
end program astinterpreter.</lang> |
|||
{{out|case=Primes}} |
|||
<pre>prompt$ ./lexer <testcases/Primes | ./parser | ./astinterpreter |
|||
3 is prime |
|||
5 is prime |
|||
7 is prime |
|||
11 is prime |
|||
13 is prime |
|||
17 is prime |
|||
19 is prime |
|||
23 is prime |
|||
29 is prime |
|||
31 is prime |
|||
37 is prime |
|||
41 is prime |
|||
43 is prime |
|||
47 is prime |
|||
53 is prime |
|||
59 is prime |
|||
61 is prime |
|||
67 is prime |
|||
71 is prime |
|||
73 is prime |
|||
79 is prime |
|||
83 is prime |
|||
89 is prime |
|||
97 is prime |
|||
101 is prime |
|||
Total primes found: 26</pre> |
|||
=={{header|Forth}}== |
=={{header|Forth}}== |