Data update
This commit is contained in:
Ingy döt Net
parent
4bb20c9b71
commit
cbaf4c4b64
12390 changed files with 318560 additions and 27248 deletions
497
Task/Compiler-AST-interpreter/COBOL/compiler-ast-interpreter.cob
Normal file
497
Task/Compiler-AST-interpreter/COBOL/compiler-ast-interpreter.cob
Normal file
|
|
@ -0,0 +1,497 @@
|
|||
>>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.
|
||||
|
|
@ -0,0 +1,303 @@
|
|||
Const NULL As Any Ptr = 0
|
||||
|
||||
Enum NodeType
|
||||
nd_Ident = 0
|
||||
nd_String, nd_Integer, nd_Sequence, nd_If, nd_Prtc, nd_Prts, nd_Prti,
|
||||
nd_While, nd_Assign, nd_Negate, nd_Not, nd_Mul, nd_Div, nd_Mod, nd_Add,
|
||||
nd_Sub, nd_Lss, nd_Leq, nd_Gtr, nd_Geq, nd_Eql, nd_Neq, nd_And, nd_Or
|
||||
End Enum
|
||||
|
||||
Type Tree
|
||||
tiponodo As Integer
|
||||
izda As Tree Ptr
|
||||
dcha As Tree Ptr
|
||||
valor As Integer
|
||||
End Type
|
||||
|
||||
Dim Shared As String string_pool()
|
||||
Dim Shared As String global_names()
|
||||
Dim Shared As Integer global_values()
|
||||
|
||||
Sub error_msg(Byval msg As String)
|
||||
Color 12: Print "Error: "; msg
|
||||
Sleep: End 1
|
||||
End Sub
|
||||
|
||||
Function make_node(Byval tiponodo As NodeType, Byref izda As Tree Ptr, Byref dcha As Tree Ptr) As Tree Ptr
|
||||
Dim puntero As Tree Ptr = New Tree
|
||||
puntero->tiponodo = tiponodo
|
||||
puntero->izda = izda
|
||||
puntero->dcha = dcha
|
||||
puntero->valor = 0
|
||||
Return puntero
|
||||
End Function
|
||||
|
||||
Function make_leaf(Byval tiponodo As NodeType, Byval valor As Integer) As Tree Ptr
|
||||
Dim puntero As Tree Ptr = New Tree
|
||||
puntero->tiponodo = tiponodo
|
||||
puntero->valor = valor
|
||||
puntero->izda = NULL
|
||||
puntero->dcha = NULL
|
||||
Return puntero
|
||||
End Function
|
||||
|
||||
Function interp(Byref x As Tree Ptr) As Integer
|
||||
If x = NULL Then Return 0
|
||||
|
||||
Select Case x->tiponodo
|
||||
Case nd_Integer
|
||||
Return x->valor
|
||||
|
||||
Case nd_Ident
|
||||
Return global_values(x->valor)
|
||||
|
||||
Case nd_String
|
||||
Return x->valor
|
||||
|
||||
Case nd_Assign
|
||||
global_values(x->izda->valor) = interp(x->dcha)
|
||||
Return global_values(x->izda->valor)
|
||||
|
||||
Case nd_Add
|
||||
Return interp(x->izda) + interp(x->dcha)
|
||||
Case nd_Sub
|
||||
Return interp(x->izda) - interp(x->dcha)
|
||||
Case nd_Mul
|
||||
Return interp(x->izda) * interp(x->dcha)
|
||||
Case nd_Div
|
||||
Return interp(x->izda) \ interp(x->dcha)
|
||||
Case nd_Mod
|
||||
Return interp(x->izda) Mod interp(x->dcha)
|
||||
|
||||
Case nd_Lss
|
||||
Return Iif(interp(x->izda) < interp(x->dcha), 1, 0)
|
||||
Case nd_Gtr
|
||||
Return Iif(interp(x->izda) > interp(x->dcha), 1, 0)
|
||||
Case nd_Leq
|
||||
Return Iif(interp(x->izda) <= interp(x->dcha), 1, 0)
|
||||
Case nd_Geq
|
||||
Return Iif(interp(x->izda) >= interp(x->dcha), 1, 0)
|
||||
Case nd_Eql
|
||||
Return Iif(interp(x->izda) = interp(x->dcha), 1, 0)
|
||||
Case nd_Neq
|
||||
Return Iif(interp(x->izda) <> interp(x->dcha), 1, 0)
|
||||
|
||||
Case nd_And
|
||||
Return Iif(interp(x->izda) <> 0 And interp(x->dcha) <> 0, 1, 0)
|
||||
Case nd_Or
|
||||
Return Iif(interp(x->izda) <> 0 Or interp(x->dcha) <> 0, 1, 0)
|
||||
|
||||
Case nd_Negate
|
||||
Return -interp(x->izda)
|
||||
|
||||
Case nd_Not
|
||||
Return Iif(interp(x->izda) = 0, 1, 0)
|
||||
|
||||
Case nd_Prtc
|
||||
Print Chr(interp(x->izda));
|
||||
Return 0
|
||||
|
||||
Case nd_Prts
|
||||
Dim As Integer idx = interp(x->izda)
|
||||
Print string_pool(idx);
|
||||
Return 0
|
||||
|
||||
Case nd_Prti
|
||||
Print interp(x->izda); " ";
|
||||
Return 0
|
||||
|
||||
Case nd_Sequence
|
||||
interp(x->izda)
|
||||
interp(x->dcha)
|
||||
Return 0
|
||||
|
||||
Case nd_If
|
||||
If interp(x->izda) <> 0 Then
|
||||
interp(x->dcha->izda)
|
||||
Else
|
||||
interp(x->dcha->dcha)
|
||||
End If
|
||||
Return 0
|
||||
|
||||
Case nd_While
|
||||
While interp(x->izda) <> 0
|
||||
interp(x->dcha)
|
||||
Wend
|
||||
Return 0
|
||||
|
||||
Case Else
|
||||
error_msg("Unknown node type en interp: " & x->tiponodo)
|
||||
End Select
|
||||
|
||||
Return 0
|
||||
End Function
|
||||
|
||||
Function fetch_string_offset(Byref raw As String) As Integer
|
||||
Dim As Integer L = Len(raw)
|
||||
|
||||
If L >= 2 Andalso Left(raw,1) = Chr(34) Andalso Right(raw,1) = Chr(34) Then
|
||||
raw = Mid(raw, 2, L - 2)
|
||||
End If
|
||||
|
||||
Dim As String cleaned = ""
|
||||
Dim As Integer i = 1
|
||||
|
||||
While i <= Len(raw)
|
||||
Dim As String c = Mid(raw, i, 1)
|
||||
|
||||
If c = "\" Andalso i < Len(raw) Then
|
||||
Dim As String nxt = Mid(raw, i + 1, 1)
|
||||
|
||||
If nxt = "n" Then
|
||||
cleaned &= Chr(10)
|
||||
i += 2
|
||||
Continue While
|
||||
Elseif nxt = "\" Then
|
||||
cleaned &= "\"
|
||||
i += 2
|
||||
Continue While
|
||||
End If
|
||||
End If
|
||||
|
||||
cleaned &= c
|
||||
i += 1
|
||||
Wend
|
||||
|
||||
For i = 0 To Ubound(string_pool)
|
||||
If string_pool(i) = cleaned Then Return i
|
||||
Next i
|
||||
|
||||
Dim As Integer newIndex = Ubound(string_pool) + 1
|
||||
Redim Preserve string_pool(newIndex)
|
||||
string_pool(newIndex) = cleaned
|
||||
|
||||
Return newIndex
|
||||
End Function
|
||||
|
||||
Function fetch_var_offset(Byval nombre As String) As Integer
|
||||
For i As Integer = 0 To Ubound(global_names)
|
||||
If global_names(i) = nombre Then Return i
|
||||
Next
|
||||
Redim Preserve global_names(0 To Ubound(global_names) + 1)
|
||||
global_names(Ubound(global_names)) = nombre
|
||||
Redim Preserve global_values(0 To Ubound(global_values) + 1)
|
||||
global_values(Ubound(global_values)) = 0
|
||||
Return Ubound(global_names)
|
||||
End Function
|
||||
|
||||
Sub Split(Byval s As String, Byval delimiter As String, tokens() As String)
|
||||
Dim As Integer cnt = 0
|
||||
Dim As Integer startPos = 1
|
||||
Dim As Integer delimPos
|
||||
|
||||
Redim tokens(0 To 0)
|
||||
|
||||
Do
|
||||
delimPos = Instr(startPos, s, delimiter)
|
||||
If delimPos = 0 Then
|
||||
Redim Preserve tokens(0 To cnt)
|
||||
tokens(cnt) = Mid(s, startPos)
|
||||
Exit Do
|
||||
Else
|
||||
Redim Preserve tokens(0 To cnt)
|
||||
tokens(cnt) = Mid(s, startPos, delimPos - startPos)
|
||||
cnt += 1
|
||||
startPos = delimPos + Len(delimiter)
|
||||
End If
|
||||
Loop
|
||||
End Sub
|
||||
|
||||
Function load_ast(Byref f As Integer) As Tree Ptr
|
||||
Dim As String linea
|
||||
If Eof(f) Then Return NULL
|
||||
Line Input #f, linea
|
||||
linea = Trim(linea)
|
||||
If linea = "" Then Return load_ast(f)
|
||||
|
||||
Dim As String tokens()
|
||||
Split(linea, " ", tokens())
|
||||
Dim As String token = tokens(0)
|
||||
If token = ";" Then Return NULL
|
||||
|
||||
Dim As Integer tiponodo = -1
|
||||
|
||||
Select Case token
|
||||
Case "Identifier" : tiponodo = nd_Ident
|
||||
Case "String" : tiponodo = nd_String
|
||||
Case "Integer" : tiponodo = nd_Integer
|
||||
Case "Sequence" : tiponodo = nd_Sequence
|
||||
Case "If" : tiponodo = nd_If
|
||||
Case "Prtc" : tiponodo = nd_Prtc
|
||||
Case "Prts" : tiponodo = nd_Prts
|
||||
Case "Prti" : tiponodo = nd_Prti
|
||||
Case "While" : tiponodo = nd_While
|
||||
Case "Assign" : tiponodo = nd_Assign
|
||||
Case "Negate" : tiponodo = nd_Negate
|
||||
Case "Not" : tiponodo = nd_Not
|
||||
Case "Multiply" : tiponodo = nd_Mul
|
||||
Case "Divide" : tiponodo = nd_Div
|
||||
Case "Mod" : tiponodo = nd_Mod
|
||||
Case "Add" : tiponodo = nd_Add
|
||||
Case "Subtract" : tiponodo = nd_Sub
|
||||
Case "Less" : tiponodo = nd_Lss
|
||||
Case "LessEqual" : tiponodo = nd_Leq
|
||||
Case "Greater" : tiponodo = nd_Gtr
|
||||
Case "GreaterEqual": tiponodo = nd_Geq
|
||||
Case "Equal" : tiponodo = nd_Eql
|
||||
Case "NotEqual" : tiponodo = nd_Neq
|
||||
Case "And" : tiponodo = nd_And
|
||||
Case "Or" : tiponodo = nd_Or
|
||||
Case Else : error_msg("Unknown token: " & token)
|
||||
End Select
|
||||
|
||||
Dim As String rest = Mid(linea, Len(token) + 1)
|
||||
rest = Ltrim(rest)
|
||||
|
||||
If rest <> "" Then
|
||||
Dim As Integer n
|
||||
Select Case tiponodo
|
||||
Case nd_Ident
|
||||
n = fetch_var_offset(rest)
|
||||
Case nd_Integer
|
||||
n = Val(rest)
|
||||
Case nd_String
|
||||
n = fetch_string_offset(rest)
|
||||
Case Else
|
||||
error_msg("Leaf with unknown node type: " & token)
|
||||
End Select
|
||||
Return make_leaf(tiponodo, n)
|
||||
End If
|
||||
|
||||
Dim As Tree Ptr izda_node = load_ast(f)
|
||||
Dim As Tree Ptr dcha_node = load_ast(f)
|
||||
|
||||
Return make_node(tiponodo, izda_node, dcha_node)
|
||||
End Function
|
||||
|
||||
Sub main()
|
||||
Redim string_pool(0 To 0)
|
||||
string_pool(0) = ""
|
||||
|
||||
Redim global_names(0 To 0)
|
||||
global_names(0) = ""
|
||||
|
||||
Redim global_values(0 To 0)
|
||||
global_values(0) = 0
|
||||
|
||||
Dim As String filename
|
||||
If Command(1) <> "" Then
|
||||
filename = Command(1)
|
||||
Else
|
||||
filename = "ast.txt"
|
||||
End If
|
||||
|
||||
Dim As Integer ff = Freefile()
|
||||
Open filename For Input As #ff
|
||||
Dim As Tree Ptr tree = load_ast(ff)
|
||||
Close #ff
|
||||
interp(tree)
|
||||
End Sub
|
||||
|
||||
main()
|
||||
|
||||
Sleep
|
||||
|
|
@ -0,0 +1,155 @@
|
|||
import java.io.File
|
||||
import java.util.*
|
||||
|
||||
internal object Interpreter {
|
||||
private val globals = mutableMapOf<String, Int>()
|
||||
private lateinit var s: Scanner
|
||||
private val strToNodes = NodeType.entries.associateBy(NodeType::value)
|
||||
|
||||
private fun str(s: String): String = buildString {
|
||||
var i = 0
|
||||
val s = s.replace("\"", "")
|
||||
while (i < s.length) {
|
||||
if (s[i] == '\\' && i + 1 < s.length) {
|
||||
if (s[i + 1] == 'n') {
|
||||
append('\n')
|
||||
i += 2
|
||||
} else if (s[i] == '\\') {
|
||||
append('\\')
|
||||
i += 2
|
||||
}
|
||||
} else {
|
||||
append(s[i])
|
||||
i++
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
private fun itob(i: Int): Boolean = i != 0
|
||||
private fun btoi(b: Boolean): Int = if (b) 1 else 0
|
||||
|
||||
private fun fetchVar(name: String): Int = globals.computeIfAbsent(name) { 0 }
|
||||
|
||||
@Throws(Exception::class)
|
||||
fun interpret(n: Node?): Int = when (n?.nt) {
|
||||
null -> 0
|
||||
NodeType.Integer -> n.value!!.toInt()
|
||||
NodeType.Ident -> fetchVar(n.value!!)
|
||||
NodeType.String -> n.value!!.toInt()
|
||||
NodeType.Assign -> {
|
||||
globals[n.left!!.value!!] = interpret(n.right)
|
||||
0
|
||||
}
|
||||
|
||||
NodeType.Add -> interpret(n.left) + interpret(n.right)
|
||||
NodeType.Sub -> interpret(n.left) - interpret(n.right)
|
||||
NodeType.Mul -> interpret(n.left) * interpret(n.right)
|
||||
NodeType.Div -> interpret(n.left) / interpret(n.right)
|
||||
NodeType.Mod -> interpret(n.left) % interpret(n.right)
|
||||
NodeType.Lss -> btoi(interpret(n.left) < interpret(n.right))
|
||||
NodeType.Leq -> btoi(interpret(n.left) <= interpret(n.right))
|
||||
NodeType.Gtr -> btoi(interpret(n.left) > interpret(n.right))
|
||||
NodeType.Geq -> btoi(interpret(n.left) >= interpret(n.right))
|
||||
NodeType.Eql -> btoi(interpret(n.left) == interpret(n.right))
|
||||
NodeType.Neq -> btoi(interpret(n.left) != interpret(n.right))
|
||||
NodeType.And -> btoi(itob(interpret(n.left)) && itob(interpret(n.right)))
|
||||
NodeType.Or -> btoi(itob(interpret(n.left)) || itob(interpret(n.right)))
|
||||
NodeType.Not -> if (interpret(n.left) == 0) 1 else 0
|
||||
|
||||
NodeType.Negate -> -interpret(n.left)
|
||||
NodeType.If -> {
|
||||
if (interpret(n.left) != 0) interpret(n.right!!.left) else interpret(n.right!!.right)
|
||||
0
|
||||
}
|
||||
|
||||
NodeType.While -> {
|
||||
while (interpret(n.left) != 0) {
|
||||
interpret(n.right)
|
||||
}
|
||||
0
|
||||
}
|
||||
|
||||
NodeType.Prtc -> {
|
||||
print(interpret(n.left).toChar().toString())
|
||||
0
|
||||
}
|
||||
|
||||
NodeType.Prti -> {
|
||||
print(interpret(n.left).toString())
|
||||
0
|
||||
}
|
||||
|
||||
NodeType.Prts -> {
|
||||
print(str(n.left!!.value!!)) //interpret(n.left));
|
||||
0
|
||||
}
|
||||
|
||||
NodeType.Sequence -> {
|
||||
interpret(n.left)
|
||||
interpret(n.right)
|
||||
0
|
||||
}
|
||||
|
||||
else -> throw Exception("Error: '${n.nt}' found, expecting operator")
|
||||
}
|
||||
|
||||
private fun loadAst(): Node? {
|
||||
|
||||
while (s.hasNext()) {
|
||||
val line = s.nextLine()
|
||||
|
||||
val (command, value) = if (line.length > 15) {
|
||||
line.substring(0, 15).trim { it <= ' ' } to line.substring(15).trim { it <= ' ' }
|
||||
} else {
|
||||
line.trim { it <= ' ' } to null
|
||||
}
|
||||
if (command == ";") return null
|
||||
|
||||
if (value != null) return Node.makeLeaf(strToNodes.getValue(command), value)
|
||||
|
||||
return Node.makeNode(
|
||||
nodeType = strToNodes[command] ?: throw Exception("Command not found: '$command'"),
|
||||
left = loadAst(),
|
||||
right = loadAst(),
|
||||
)
|
||||
}
|
||||
return null // for the compiler, not needed
|
||||
}
|
||||
|
||||
@JvmStatic
|
||||
fun main(args: Array<String>) {
|
||||
if (args.isNotEmpty()) {
|
||||
try {
|
||||
s = Scanner(File(args[0]))
|
||||
val n = loadAst()
|
||||
interpret(n)
|
||||
} catch (e: Exception) {
|
||||
println("Ex: " + e.message)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
internal class Node(
|
||||
val nt: NodeType,
|
||||
var left: Node? = null,
|
||||
var right: Node? = null,
|
||||
var value: String? = null,
|
||||
) {
|
||||
companion object {
|
||||
fun makeNode(nodeType: NodeType, left: Node?, right: Node?): Node = Node(nodeType, left, right, "")
|
||||
fun makeLeaf(nodeType: NodeType, value: String?): Node = Node(nodeType, null, null, value)
|
||||
}
|
||||
}
|
||||
|
||||
internal enum class NodeType(val value: String) {
|
||||
None(";"), Ident("Identifier"), String("String"), Integer("Integer"),
|
||||
Sequence("Sequence"), If("If"),
|
||||
Prtc("Prtc"), Prts("Prts"), Prti("Prti"), While("While"),
|
||||
Assign("Assign"), Negate("Negate"), Not("Not"), Mul("Multiply"), Div("Divide"),
|
||||
Mod("Mod"), Add("Add"),
|
||||
Sub("Subtract"), Lss("Less"), Leq("LessEqual"),
|
||||
Gtr("Greater"), Geq("GreaterEqual"), Eql("Equal"), Neq("NotEqual"), And("And"), Or("Or");
|
||||
|
||||
override fun toString() = value
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,70 @@
|
|||
Red [
|
||||
Title: "Compiler/AST interpreter"
|
||||
Author: "hinjolicious"
|
||||
]
|
||||
|
||||
#include %lex2-bak.red
|
||||
#include %parse.red
|
||||
#include %../../mylib/mylib.red
|
||||
#include %../../mylib/profiler-greg.red
|
||||
|
||||
INTERP: func [a /local var-pool x][
|
||||
var-pool: #[]
|
||||
error: func [msg][ print ["ERROR:" msg] halt ]
|
||||
|
||||
EVAL: func [a /local x][
|
||||
if none? a [ return none ]
|
||||
switch/default a/1 [
|
||||
SEQ [ eval a/2 eval a/3 ]
|
||||
INT [ to integer! a/2 ]
|
||||
ID [ var-pool/(:a/2) ]
|
||||
STR [ a/2 ]
|
||||
ASGN [ var-pool/(:a/2/2): eval a/3 ]
|
||||
ADD [ (eval a/2) + (eval a/3) ]
|
||||
SUB [ (eval a/2) - (eval a/3) ]
|
||||
MUL [ (eval a/2) * (eval a/3) ]
|
||||
DIV [ to integer! (eval a/2) / (eval a/3) ]
|
||||
MOD [ to integer! modulo (eval a/2) (eval a/3) ]
|
||||
LT [ either (eval a/2) < (eval a/3) [1][0] ]
|
||||
GT [ either (eval a/2) > (eval a/3) [1][0] ]
|
||||
LEQ [ either (eval a/2) <= (eval a/3) [1][0] ]
|
||||
GEQ [ either (eval a/2) >= (eval a/3) [1][0] ]
|
||||
EQ [ either (eval a/2) = (eval a/3) [1][0] ]
|
||||
NEQ [ either (eval a/2) <> (eval a/3) [1][0] ]
|
||||
AND [ (eval a/2) * (eval a/3) ]
|
||||
OR [ either any [(eval a/2) <> 0 (eval a/3) <> 0] [1][0] ]
|
||||
NEG [ negate eval a/2 ]
|
||||
NOT [ either (eval a/2) = 0 [1][0] ]
|
||||
IF [ either (eval a/2) <> 0 [eval a/3/2][eval a/3/3] ]
|
||||
WHILE [ while [(eval a/2) <> 0][eval a/3] ]
|
||||
PRTC [ prin to char! eval a/2 ]
|
||||
PRTI [ prin to integer! eval a/2 ]
|
||||
PRTS [ x: eval a/2
|
||||
replace/all x "\\n" "`n`" replace/all x "\n" "^/"
|
||||
prin replace/all x "`n`" "\n" ]
|
||||
][ error rejoin ["Expecting operator, found '" a/1 "'"] ]
|
||||
]
|
||||
eval a
|
||||
]
|
||||
|
||||
test: does [
|
||||
while [(tx: ask "Code: ") <> ""] [
|
||||
case [
|
||||
tx = "r" [tx: read fn: request-file]
|
||||
all [tx = "s" fn <> "" ast <> []] [
|
||||
out-fn: replace fn ".t" ".ast"
|
||||
write out-fn ast
|
||||
print ["Saved to " out-fn]
|
||||
continue ] ]
|
||||
?? fn
|
||||
;?? tx
|
||||
;print tx
|
||||
lx: lex tx
|
||||
;?? lx
|
||||
ast: parse lx
|
||||
?? ast
|
||||
timer: [interp ast]
|
||||
profile/show [timer]
|
||||
]
|
||||
]
|
||||
test
|
||||
Loading…
Add table
Add a link
Reference in a new issue