Data update
This commit is contained in:
Ingy döt Net
parent
5150844a7d
commit
4bb20c9b71
7735 changed files with 38060 additions and 199180 deletions
|
|
@ -1,497 +0,0 @@
|
|||
>>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.
|
||||
|
|
@ -1,71 +1,66 @@
|
|||
(phixonline)-->
|
||||
<span style="color: #000080;font-style:italic;">--
|
||||
-- demo\rosetta\Compiler\interp.exw
|
||||
-- ================================
|
||||
--</span>
|
||||
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
|
||||
<span style="color: #008080;">include</span> <span style="color: #000000;">parse</span><span style="color: #0000FF;">.</span><span style="color: #000000;">e</span>
|
||||
-- demo\rosetta\Compiler\interp.exw
|
||||
with javascript_semantics
|
||||
include parse.e
|
||||
|
||||
<span style="color: #004080;">sequence</span> <span style="color: #000000;">vars</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{},</span>
|
||||
<span style="color: #000000;">vals</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{}</span>
|
||||
sequence vars = {},
|
||||
vals = {}
|
||||
|
||||
<span style="color: #008080;">function</span> <span style="color: #000000;">var_idx</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">inode</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">if</span> <span style="color: #000000;">inode</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]!=</span><span style="color: #000000;">tk_Identifier</span> <span style="color: #008080;">then</span> <span style="color: #0000FF;">?</span><span style="color: #000000;">9</span><span style="color: #0000FF;">/</span><span style="color: #000000;">0</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
|
||||
<span style="color: #004080;">string</span> <span style="color: #000000;">ident</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">inode</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">]</span>
|
||||
<span style="color: #004080;">integer</span> <span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">ident</span><span style="color: #0000FF;">,</span><span style="color: #000000;">vars</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">if</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
|
||||
<span style="color: #000000;">vars</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">vars</span><span style="color: #0000FF;">,</span><span style="color: #000000;">ident</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #000000;">vals</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">vals</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">vars</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
|
||||
<span style="color: #008080;">return</span> <span style="color: #000000;">n</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
|
||||
function var_idx(sequence inode)
|
||||
if inode[1]!=tk_Identifier then ?9/0 end if
|
||||
string ident = inode[2]
|
||||
integer n = find(ident,vars)
|
||||
if n=0 then
|
||||
vars = append(vars,ident)
|
||||
vals = append(vals,0)
|
||||
n = length(vars)
|
||||
end if
|
||||
return n
|
||||
end function
|
||||
|
||||
<span style="color: #008080;">function</span> <span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #004080;">object</span> <span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">if</span> <span style="color: #000000;">t</span><span style="color: #0000FF;">!=</span><span style="color: #004600;">NULL</span> <span style="color: #008080;">then</span>
|
||||
<span style="color: #004080;">integer</span> <span style="color: #000000;">ntype</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span>
|
||||
<span style="color: #004080;">object</span> <span style="color: #000000;">t2</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">],</span>
|
||||
<span style="color: #000000;">t3</span> <span style="color: #0000FF;">=</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">)=</span><span style="color: #000000;">3</span><span style="color: #0000FF;">?</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">3</span><span style="color: #0000FF;">]:</span><span style="color: #000000;">0</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">switch</span> <span style="color: #000000;">ntype</span> <span style="color: #008080;">do</span>
|
||||
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_Sequence</span><span style="color: #0000FF;">:</span> <span style="color: #0000FF;">{}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t2</span><span style="color: #0000FF;">)</span> <span style="color: #0000FF;">{}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t3</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_assign</span><span style="color: #0000FF;">:</span> <span style="color: #000000;">vals</span><span style="color: #0000FF;">[</span><span style="color: #000000;">var_idx</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t2</span><span style="color: #0000FF;">)]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t3</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_Identifier</span><span style="color: #0000FF;">:</span> <span style="color: #008080;">return</span> <span style="color: #000000;">vals</span><span style="color: #0000FF;">[</span><span style="color: #000000;">var_idx</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">)]</span>
|
||||
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_Integer</span><span style="color: #0000FF;">:</span> <span style="color: #008080;">return</span> <span style="color: #000000;">t2</span>
|
||||
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_String</span><span style="color: #0000FF;">:</span> <span style="color: #008080;">return</span> <span style="color: #000000;">t2</span>
|
||||
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_lt</span><span style="color: #0000FF;">:</span> <span style="color: #008080;">return</span> <span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t2</span><span style="color: #0000FF;">)</span> <span style="color: #0000FF;"><</span> <span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t3</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_add</span><span style="color: #0000FF;">:</span> <span style="color: #008080;">return</span> <span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t2</span><span style="color: #0000FF;">)</span> <span style="color: #0000FF;">+</span> <span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t3</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_sub</span><span style="color: #0000FF;">:</span> <span style="color: #008080;">return</span> <span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t2</span><span style="color: #0000FF;">)</span> <span style="color: #0000FF;">-</span> <span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t3</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_while</span><span style="color: #0000FF;">:</span> <span style="color: #008080;">while</span> <span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t2</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span> <span style="color: #0000FF;">{}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t3</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
|
||||
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_Prints</span><span style="color: #0000FF;">:</span> <span style="color: #7060A8;">puts</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t2</span><span style="color: #0000FF;">))</span>
|
||||
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_Printi</span><span style="color: #0000FF;">:</span> <span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%d"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t2</span><span style="color: #0000FF;">))</span>
|
||||
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_putc</span><span style="color: #0000FF;">:</span> <span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%c"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t2</span><span style="color: #0000FF;">))</span>
|
||||
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_and</span><span style="color: #0000FF;">:</span> <span style="color: #008080;">return</span> <span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t2</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">and</span> <span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t3</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_or</span><span style="color: #0000FF;">:</span> <span style="color: #008080;">return</span> <span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t2</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">or</span> <span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t3</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_le</span><span style="color: #0000FF;">:</span> <span style="color: #008080;">return</span> <span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t2</span><span style="color: #0000FF;">)</span> <span style="color: #0000FF;"><=</span> <span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t3</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_ge</span><span style="color: #0000FF;">:</span> <span style="color: #008080;">return</span> <span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t2</span><span style="color: #0000FF;">)</span> <span style="color: #0000FF;">>=</span> <span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t3</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_ne</span><span style="color: #0000FF;">:</span> <span style="color: #008080;">return</span> <span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t2</span><span style="color: #0000FF;">)</span> <span style="color: #0000FF;">!=</span> <span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t3</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_gt</span><span style="color: #0000FF;">:</span> <span style="color: #008080;">return</span> <span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t2</span><span style="color: #0000FF;">)</span> <span style="color: #0000FF;">></span> <span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t3</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_mul</span><span style="color: #0000FF;">:</span> <span style="color: #008080;">return</span> <span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t2</span><span style="color: #0000FF;">)</span> <span style="color: #0000FF;">*</span> <span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t3</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_div</span><span style="color: #0000FF;">:</span> <span style="color: #008080;">return</span> <span style="color: #7060A8;">trunc</span><span style="color: #0000FF;">(</span><span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t2</span><span style="color: #0000FF;">)/</span><span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t3</span><span style="color: #0000FF;">))</span>
|
||||
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_mod</span><span style="color: #0000FF;">:</span> <span style="color: #008080;">return</span> <span style="color: #7060A8;">remainder</span><span style="color: #0000FF;">(</span><span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t2</span><span style="color: #0000FF;">),</span><span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t3</span><span style="color: #0000FF;">))</span>
|
||||
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_if</span><span style="color: #0000FF;">:</span> <span style="color: #0000FF;">{}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t3</span><span style="color: #0000FF;">[</span><span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t2</span><span style="color: #0000FF;">)?</span><span style="color: #000000;">2</span><span style="color: #0000FF;">:</span><span style="color: #000000;">3</span><span style="color: #0000FF;">)])</span>
|
||||
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_not</span><span style="color: #0000FF;">:</span> <span style="color: #008080;">return</span> <span style="color: #008080;">not</span> <span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t2</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">case</span> <span style="color: #000000;">tk_neg</span><span style="color: #0000FF;">:</span> <span style="color: #008080;">return</span> <span style="color: #0000FF;">-</span> <span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t2</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">else</span>
|
||||
<span style="color: #000000;">error</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"unknown node type"</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">switch</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
|
||||
<span style="color: #008080;">return</span> <span style="color: #004600;">NULL</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
|
||||
function interp(object t)
|
||||
if t!=NULL then
|
||||
integer ntype = t[1]
|
||||
object t2 = t[2],
|
||||
t3 = iff(length(t)=3?t[3]:0)
|
||||
switch ntype do
|
||||
case tk_Sequence: {} = interp(t2) {} = interp(t3)
|
||||
case tk_assign: vals[var_idx(t2)] = interp(t3)
|
||||
case tk_Identifier: return vals[var_idx(t)]
|
||||
case tk_Integer: return t2
|
||||
case tk_String: return t2
|
||||
case tk_lt: return interp(t2) < interp(t3)
|
||||
case tk_add: return interp(t2) + interp(t3)
|
||||
case tk_sub: return interp(t2) - interp(t3)
|
||||
case tk_while: while interp(t2) do {} = interp(t3) end while
|
||||
case tk_Prints: puts(1,interp(t2))
|
||||
case tk_Printi: printf(1,"%d",interp(t2))
|
||||
case tk_putc: printf(1,"%c",interp(t2))
|
||||
case tk_and: return interp(t2) and interp(t3)
|
||||
case tk_or: return interp(t2) or interp(t3)
|
||||
case tk_le: return interp(t2) <= interp(t3)
|
||||
case tk_ge: return interp(t2) >= interp(t3)
|
||||
case tk_ne: return interp(t2) != interp(t3)
|
||||
case tk_gt: return interp(t2) > interp(t3)
|
||||
case tk_mul: return interp(t2) * interp(t3)
|
||||
case tk_div: return trunc(interp(t2)/interp(t3))
|
||||
case tk_mod: return remainder(interp(t2),interp(t3))
|
||||
case tk_if: {} = interp(t3[iff(interp(t2)?2:3)])
|
||||
case tk_not: return not interp(t2)
|
||||
case tk_neg: return - interp(t2)
|
||||
else
|
||||
error("unknown node type")
|
||||
end switch
|
||||
end if
|
||||
return NULL
|
||||
end function
|
||||
|
||||
<span style="color: #008080;">procedure</span> <span style="color: #000000;">main</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">cl</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #000000;">open_files</span><span style="color: #0000FF;">(</span><span style="color: #000000;">cl</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #000000;">toks</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">lex</span><span style="color: #0000FF;">()</span>
|
||||
<span style="color: #004080;">object</span> <span style="color: #000000;">t</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">parse</span><span style="color: #0000FF;">()</span>
|
||||
<span style="color: #0000FF;">{}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">interp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #000000;">close_files</span><span style="color: #0000FF;">()</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
|
||||
procedure main(sequence cl)
|
||||
open_files(cl)
|
||||
toks = lex()
|
||||
object t = parse()
|
||||
{} = interp(t)
|
||||
close_files()
|
||||
end procedure
|
||||
|
||||
<span style="color: #000080;font-style:italic;">--main(command_line())</span>
|
||||
<span style="color: #000000;">main</span><span style="color: #0000FF;">({</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"primes.c"</span><span style="color: #0000FF;">})</span>
|
||||
<!--
|
||||
--main(command_line())
|
||||
main({0,0,"primes.c"})
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue