Anonymous user
Compiler/AST interpreter: Difference between revisions
Add COBOL
(Added Forth implementation) |
(Add COBOL) |
||
Line 742:
</pre>
</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}}==
| |||