Data update
This commit is contained in:
Ingy döt Net
parent
4bb20c9b71
commit
cbaf4c4b64
12390 changed files with 318560 additions and 27248 deletions
606
Task/Compiler-syntax-analyzer/COBOL/compiler-syntax-analyzer.cob
Normal file
606
Task/Compiler-syntax-analyzer/COBOL/compiler-syntax-analyzer.cob
Normal file
|
|
@ -0,0 +1,606 @@
|
|||
>>SOURCE FORMAT IS FREE
|
||||
identification division.
|
||||
*> this code is dedicated to the public domain
|
||||
*> (GnuCOBOL) 2.3-dev.0
|
||||
*> for extra credit, generate this program directly from the EBNF
|
||||
program-id. parser.
|
||||
environment division.
|
||||
configuration section.
|
||||
repository. function all intrinsic.
|
||||
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 global.
|
||||
01 input-record global.
|
||||
03 input-line pic zzzz9.
|
||||
03 input-column pic zzzzzz9.
|
||||
03 filler pic x(3).
|
||||
03 input-token pic x(16).
|
||||
03 input-value pic x(48).
|
||||
|
||||
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 line-no pic 999 value 0.
|
||||
01 col-no pic 99 value 0.
|
||||
|
||||
01 error-record global.
|
||||
03 error-line-no pic zzzz9.
|
||||
03 error-col-no pic zzzzzz9.
|
||||
03 filler pic x value space.
|
||||
03 error-message pic x(64) value spaces.
|
||||
|
||||
01 token global.
|
||||
03 token-type pic x(16).
|
||||
03 token-line pic 999.
|
||||
03 token-column pic 99.
|
||||
03 token-value pic x(48).
|
||||
|
||||
01 parse-stack global.
|
||||
03 p pic 999 value 0.
|
||||
03 p-lim pic 999 value 200.
|
||||
03 p-zero pic 999 value 0.
|
||||
03 parse-entry occurs 200.
|
||||
05 parse-name pic x(24).
|
||||
05 parse-token pic x(16).
|
||||
05 parse-left pic 999.
|
||||
05 parse-right pic 999.
|
||||
05 parse-work pic 999.
|
||||
05 parse-work1 pic 999.
|
||||
|
||||
01 abstract-syntax-tree global.
|
||||
03 t pic 999 value 0.
|
||||
03 t1 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 indent pic x(200) value all '| ' global.
|
||||
|
||||
procedure division chaining program-name.
|
||||
start-parser.
|
||||
if program-name <> spaces
|
||||
string program-name delimited by space '.lex' into input-name
|
||||
open input input-file
|
||||
if input-status <> '00'
|
||||
string 'in parser ' trim(input-name) ' open status ' input-status
|
||||
into error-message
|
||||
call 'reporterror'
|
||||
end-if
|
||||
end-if
|
||||
call 'gettoken'
|
||||
call 'stmt_list'
|
||||
if input-name <> spaces
|
||||
close input-file
|
||||
end-if
|
||||
|
||||
call 'printast' using t
|
||||
|
||||
>>d perform dump-ast
|
||||
|
||||
stop run
|
||||
.
|
||||
dump-ast.
|
||||
display '==========' upon syserr
|
||||
display 'ast:' upon syserr
|
||||
display 't=' t upon syserr
|
||||
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. stmt_list common recursive.
|
||||
data division.
|
||||
procedure division.
|
||||
start-stmt_list.
|
||||
call 'push' using module-id
|
||||
move p-zero to parse-left(p)
|
||||
perform forever
|
||||
call 'stmt'
|
||||
move return-code to parse-right(p)
|
||||
call 'makenode' using 'Sequence' parse-left(p) parse-right(p)
|
||||
move return-code to parse-left(p)
|
||||
if parse-right(p) = 0
|
||||
or token-type = 'End_of_input'
|
||||
exit perform
|
||||
end-if
|
||||
end-perform
|
||||
call 'pop'
|
||||
.
|
||||
end program stmt_list.
|
||||
|
||||
identification division.
|
||||
program-id. stmt common recursive.
|
||||
procedure division.
|
||||
start-stmt.
|
||||
call 'push' using module-id
|
||||
move p-zero to parse-left(p)
|
||||
evaluate token-type
|
||||
when 'Semicolon'
|
||||
call 'gettoken'
|
||||
when 'Identifier'
|
||||
*>Identifier '=' expr ';'
|
||||
call 'makeleaf' using 'Identifier' token-value
|
||||
move return-code to parse-left(p)
|
||||
call 'gettoken'
|
||||
call 'expect' using 'Op_assign'
|
||||
call 'expr'
|
||||
move return-code to parse-right(p)
|
||||
call 'expect' using 'Semicolon'
|
||||
call 'makenode' using 'Assign' parse-left(p) parse-right(p)
|
||||
move return-code to parse-left(p)
|
||||
when 'Keyword_while'
|
||||
*>'while' paren_expr '{' stmt '}'
|
||||
call 'gettoken'
|
||||
call 'paren_expr'
|
||||
move return-code to parse-work(p)
|
||||
call 'stmt'
|
||||
move return-code to parse-right(p)
|
||||
call 'makenode' using 'While' parse-work(p) parse-right(p)
|
||||
move return-code to parse-left(p)
|
||||
when 'Keyword_if'
|
||||
*>'if' paren_expr stmt ['else' stmt]
|
||||
call 'gettoken'
|
||||
call 'paren_expr'
|
||||
move return-code to parse-left(p)
|
||||
call 'stmt'
|
||||
move return-code to parse-work(p)
|
||||
move p-zero to parse-work1(p)
|
||||
if token-type = 'Keyword_else'
|
||||
call 'gettoken'
|
||||
call 'stmt'
|
||||
move return-code to parse-work1(p)
|
||||
end-if
|
||||
call 'makenode' using 'If' parse-work(p) parse-work1(p)
|
||||
move return-code to parse-right(p)
|
||||
call 'makenode' using 'If' parse-left(p) parse-right(p)
|
||||
move return-code to parse-left(p)
|
||||
when 'Keyword_print'
|
||||
*>'print' '(' prt_list ')' ';'
|
||||
call 'gettoken'
|
||||
call 'expect' using 'LeftParen'
|
||||
call 'prt_list'
|
||||
move return-code to parse-left(p)
|
||||
call 'expect' using 'RightParen'
|
||||
call 'expect' using 'Semicolon'
|
||||
when 'Keyword_putc'
|
||||
*>'putc' paren_expr ';'
|
||||
call 'gettoken'
|
||||
call 'paren_expr'
|
||||
move return-code to parse-left(p)
|
||||
call 'makenode' using 'Prtc' parse-left(p) p-zero
|
||||
move return-code to parse-left(p)
|
||||
call 'expect' using 'Semicolon'
|
||||
when 'LeftBrace'
|
||||
*>'{' stmt '}'
|
||||
call 'gettoken'
|
||||
move p-zero to parse-left(p)
|
||||
perform until token-type = 'RightBrace' or 'End_of_input'
|
||||
call 'stmt'
|
||||
move return-code to parse-right(p)
|
||||
call 'makenode' using 'Sequence' parse-left(p) parse-right(p)
|
||||
move return-code to parse-left(p)
|
||||
end-perform
|
||||
if token-type <> 'End_of_input'
|
||||
call 'gettoken'
|
||||
end-if
|
||||
when other
|
||||
move 0 to parse-left(p)
|
||||
end-evaluate
|
||||
move parse-left(p) to return-code
|
||||
call 'pop'
|
||||
.
|
||||
end program stmt.
|
||||
|
||||
identification division.
|
||||
program-id. paren_expr common recursive.
|
||||
procedure division.
|
||||
start-paren_expr.
|
||||
*>'(' expr ')' ;
|
||||
call 'push' using module-id
|
||||
call 'expect' using 'LeftParen'
|
||||
call 'expr'
|
||||
call 'expect' using 'RightParen'
|
||||
call 'pop'
|
||||
.
|
||||
end program paren_expr.
|
||||
|
||||
identification division.
|
||||
program-id. prt_list common.
|
||||
procedure division.
|
||||
start-prt_list.
|
||||
*>(string | expr) {',' (String | expr)} ;
|
||||
call 'push' using module-id
|
||||
move p-zero to parse-work(p)
|
||||
perform prt_entry
|
||||
perform until token-type <> 'Comma'
|
||||
call 'gettoken'
|
||||
perform prt_entry
|
||||
end-perform
|
||||
call 'pop'
|
||||
exit program
|
||||
.
|
||||
prt_entry.
|
||||
if token-type = 'String'
|
||||
call 'makeleaf' using token-type token-value
|
||||
move return-code to parse-left(p)
|
||||
call 'makenode' using 'Prts' parse-left(p) p-zero
|
||||
call 'gettoken'
|
||||
else
|
||||
call 'expr'
|
||||
move return-code to parse-left(p)
|
||||
call 'makenode' using 'Prti' parse-left(p) p-zero
|
||||
end-if
|
||||
move return-code to parse-right(p)
|
||||
call 'makenode' using 'Sequence' parse-work(p) parse-right(p)
|
||||
move return-code to parse-work(p)
|
||||
.
|
||||
end program prt_list.
|
||||
|
||||
identification division.
|
||||
program-id. expr common recursive.
|
||||
procedure division.
|
||||
start-expr.
|
||||
*>and_expr {'||' and_expr} ;
|
||||
call 'push' using module-id
|
||||
call 'and_expr'
|
||||
move return-code to parse-left(p)
|
||||
perform forever
|
||||
if token-type <> 'Op_or'
|
||||
exit perform
|
||||
end-if
|
||||
call 'gettoken'
|
||||
call 'and_expr'
|
||||
move return-code to parse-right(p)
|
||||
call 'makenode' using 'Or' parse-left(p) parse-right(p)
|
||||
move return-code to parse-left(p)
|
||||
end-perform
|
||||
move parse-left(p) to return-code
|
||||
call 'pop'
|
||||
.
|
||||
end program expr.
|
||||
|
||||
identification division.
|
||||
program-id. and_expr common recursive.
|
||||
procedure division.
|
||||
start-and_expr.
|
||||
*>equality_expr {'&&' equality_expr} ;
|
||||
call 'push' using module-id
|
||||
call 'equality_expr'
|
||||
move return-code to parse-left(p)
|
||||
perform forever
|
||||
if token-type <> 'Op_and'
|
||||
exit perform
|
||||
end-if
|
||||
call 'gettoken'
|
||||
call 'equality_expr'
|
||||
move return-code to parse-right(p)
|
||||
call 'makenode' using 'And' parse-left(p) parse-right(p)
|
||||
move return-code to parse-left(p)
|
||||
end-perform
|
||||
call 'pop'
|
||||
.
|
||||
end program and_expr.
|
||||
|
||||
identification division.
|
||||
program-id. equality_expr common recursive.
|
||||
procedure division.
|
||||
start-equality_expr.
|
||||
*>relational_expr [('==' | '!=') relational_expr] ;
|
||||
call 'push' using module-id
|
||||
call 'relational_expr'
|
||||
move return-code to parse-left(p)
|
||||
evaluate token-type
|
||||
when 'Op_equal'
|
||||
move 'Equal' to parse-token(p)
|
||||
when 'Op_notequal'
|
||||
move 'NotEqual' to parse-token(p)
|
||||
end-evaluate
|
||||
if parse-token(p) <> spaces
|
||||
call 'gettoken'
|
||||
call 'relational_expr'
|
||||
move return-code to parse-right(p)
|
||||
call 'makenode' using parse-token(p) parse-left(p) parse-right(p)
|
||||
move return-code to parse-left(p)
|
||||
end-if
|
||||
call 'pop'
|
||||
.
|
||||
end program equality_expr.
|
||||
|
||||
identification division.
|
||||
program-id. relational_expr common recursive.
|
||||
procedure division.
|
||||
start-relational_expr.
|
||||
*>addition_expr [('<' | '<=' | '>' | '>=') addition_expr] ;
|
||||
call 'push' using module-id
|
||||
call 'addition_expr'
|
||||
move return-code to parse-left(p)
|
||||
evaluate token-type
|
||||
when 'Op_less'
|
||||
move 'Less' to parse-token(p)
|
||||
when 'Op_lessequal'
|
||||
move 'LessEqual' to parse-token(p)
|
||||
when 'Op_greater'
|
||||
move 'Greater' to parse-token(p)
|
||||
when 'Op_greaterequal'
|
||||
move 'GreaterEqual' to parse-token(p)
|
||||
end-evaluate
|
||||
if parse-token(p) <> spaces
|
||||
call 'gettoken'
|
||||
call 'addition_expr'
|
||||
move return-code to parse-right(p)
|
||||
call 'makenode' using parse-token(p) parse-left(p) parse-right(p)
|
||||
move return-code to parse-left(p)
|
||||
end-if
|
||||
call 'pop'
|
||||
.
|
||||
end program relational_expr.
|
||||
|
||||
identification division.
|
||||
program-id. addition_expr common recursive.
|
||||
procedure division.
|
||||
start-addition_expr.
|
||||
*>multiplication_expr {('+' | '-') multiplication_expr} ;
|
||||
call 'push' using module-id
|
||||
call 'multiplication_expr'
|
||||
move return-code to parse-left(p)
|
||||
perform forever
|
||||
evaluate token-type
|
||||
when 'Op_add'
|
||||
move 'Add' to parse-token(p)
|
||||
when 'Op_subtract'
|
||||
move 'Subtract' to parse-token(p)
|
||||
when other
|
||||
exit perform
|
||||
end-evaluate
|
||||
call 'gettoken'
|
||||
call 'multiplication_expr'
|
||||
move return-code to parse-right(p)
|
||||
call 'makenode' using parse-token(p) parse-left(p) parse-right(p)
|
||||
move return-code to parse-left(p)
|
||||
end-perform
|
||||
call 'pop'
|
||||
.
|
||||
end program addition_expr.
|
||||
|
||||
identification division.
|
||||
program-id. multiplication_expr common recursive.
|
||||
procedure division.
|
||||
start-multiplication_expr.
|
||||
*>primary {('*' | '/' | '%') primary } ;
|
||||
call 'push' using module-id
|
||||
call 'primary'
|
||||
move return-code to parse-left(p)
|
||||
perform forever
|
||||
evaluate token-type
|
||||
when 'Op_multiply'
|
||||
move 'Multiply' to parse-token(p)
|
||||
when 'Op_divide'
|
||||
move 'Divide' to parse-token(p)
|
||||
when 'Op_mod'
|
||||
move 'Mod' to parse-token(p)
|
||||
when other
|
||||
exit perform
|
||||
end-evaluate
|
||||
call 'gettoken'
|
||||
call 'primary'
|
||||
move return-code to parse-right(p)
|
||||
call 'makenode' using parse-token(p) parse-left(p) parse-right(p)
|
||||
move return-code to parse-left(p)
|
||||
end-perform
|
||||
call 'pop'
|
||||
.
|
||||
end program multiplication_expr.
|
||||
|
||||
identification division.
|
||||
program-id. primary common recursive.
|
||||
procedure division.
|
||||
start-primary.
|
||||
*> Identifier
|
||||
*>| Integer
|
||||
*>| 'LeftParen' expr 'RightParen'
|
||||
*>| ('+' | '-' | '!') primary
|
||||
*>;
|
||||
call 'push' using module-id
|
||||
evaluate token-type
|
||||
when 'Identifier'
|
||||
call 'makeleaf' using 'Identifier' token-value
|
||||
call 'gettoken'
|
||||
when 'Integer'
|
||||
call 'makeleaf' using 'Integer' token-value
|
||||
call 'gettoken'
|
||||
when 'LeftParen'
|
||||
call 'gettoken'
|
||||
call 'expr'
|
||||
call 'expect' using 'RightParen'
|
||||
move t to return-code
|
||||
when 'Op_add'
|
||||
call 'gettoken'
|
||||
call 'primary'
|
||||
when 'Op_subtract'
|
||||
call 'gettoken'
|
||||
call 'primary'
|
||||
move return-code to parse-left(p)
|
||||
call 'makenode' using 'Negate' parse-left(p) p-zero
|
||||
when 'Op_not'
|
||||
call 'gettoken'
|
||||
call 'primary'
|
||||
move return-code to parse-left(p)
|
||||
call 'makenode' using 'Not' parse-left(p) p-zero
|
||||
when other
|
||||
move 0 to return-code
|
||||
end-evaluate
|
||||
call 'pop'
|
||||
.
|
||||
end program primary.
|
||||
|
||||
program-id. reporterror common.
|
||||
procedure division.
|
||||
start-reporterror.
|
||||
report-error.
|
||||
move token-line to error-line-no
|
||||
move token-column to error-col-no
|
||||
display error-record upon syserr
|
||||
stop run with error status -1
|
||||
.
|
||||
end program reporterror.
|
||||
|
||||
identification division.
|
||||
program-id. gettoken common.
|
||||
procedure division.
|
||||
start-gettoken.
|
||||
if program-name = spaces
|
||||
move '00' to input-status
|
||||
accept input-record on exception move '10' to input-status end-accept
|
||||
else
|
||||
read input-file
|
||||
end-if
|
||||
|
||||
evaluate input-status
|
||||
when '00'
|
||||
move input-token to token-type
|
||||
move input-value to token-value
|
||||
move numval(input-line) to token-line
|
||||
move numval(input-column) to token-column
|
||||
>>d display indent(1:min(4 * p,length(indent))) 'new token: ' token-type upon syserr
|
||||
when '10'
|
||||
string 'in parser ' trim(input-name) ' unexpected end of input'
|
||||
into error-message
|
||||
call 'reporterror'
|
||||
when other
|
||||
string 'in parser ' trim(input-name) ' unexpected input-status ' input-status
|
||||
into error-message
|
||||
call 'reporterror'
|
||||
end-evaluate
|
||||
.
|
||||
end program gettoken.
|
||||
|
||||
identification division.
|
||||
program-id. expect common.
|
||||
data division.
|
||||
linkage section.
|
||||
01 what any length.
|
||||
procedure division using what.
|
||||
start-expect.
|
||||
if token-type <> what
|
||||
string 'in parser expected ' what ' found ' token-type into error-message
|
||||
call 'reporterror'
|
||||
end-if
|
||||
>>d display indent(1:min(4 * p,length(indent))) 'match: ' token-type upon syserr
|
||||
call 'gettoken'
|
||||
.
|
||||
end program expect.
|
||||
|
||||
identification division.
|
||||
program-id. push common.
|
||||
data division.
|
||||
linkage section.
|
||||
01 what any length.
|
||||
procedure division using what.
|
||||
start-push.
|
||||
>>d display indent(1:min(4 * p,length(indent))) 'push ' what upon syserr
|
||||
if p >= p-lim
|
||||
move 'in parser stack overflow' to error-message
|
||||
call 'reporterror'
|
||||
end-if
|
||||
add 1 to p
|
||||
initialize parse-entry(p)
|
||||
move what to parse-name(p)
|
||||
.
|
||||
end program push.
|
||||
|
||||
identification division.
|
||||
program-id. pop common.
|
||||
procedure division.
|
||||
start-pop.
|
||||
if p < 1
|
||||
move 'in parser stack underflow' to error-message
|
||||
call 'reporterror'
|
||||
end-if
|
||||
>>d display indent(1:4 * p - 4) 'pop ' parse-name(p) upon syserr
|
||||
subtract 1 from p
|
||||
.
|
||||
end program pop.
|
||||
|
||||
identification division.
|
||||
program-id. makenode common.
|
||||
data division.
|
||||
linkage section.
|
||||
01 parm-type any length.
|
||||
01 parm-left pic 999.
|
||||
01 parm-right pic 999.
|
||||
procedure division using parm-type parm-left parm-right.
|
||||
start-makenode.
|
||||
if t >= t-lim
|
||||
string 'in parser makenode tree index t exceeds ' t-lim into error-message
|
||||
call 'reporterror'
|
||||
end-if
|
||||
add 1 to t
|
||||
move parm-type to node-type(t)
|
||||
move parm-left to node-left(t)
|
||||
move parm-right to node-right(t)
|
||||
move t to return-code
|
||||
.
|
||||
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.
|
||||
if t >= t-lim
|
||||
string 'in parser makeleaf tree index t exceeds ' t-lim into error-message
|
||||
call 'reporterror'
|
||||
end-if
|
||||
add 1 to t
|
||||
move parm-type to leaf-type(t)
|
||||
move parm-value to leaf-value(t)
|
||||
move t to return-code
|
||||
.
|
||||
end program makeleaf.
|
||||
|
||||
identification division.
|
||||
program-id. printast recursive.
|
||||
data division.
|
||||
linkage section.
|
||||
01 n pic 999.
|
||||
procedure division using n.
|
||||
start-printast.
|
||||
if n = 0
|
||||
display ';'
|
||||
exit program
|
||||
end-if
|
||||
evaluate leaf-type(n)
|
||||
when 'Identifier'
|
||||
when 'Integer'
|
||||
when 'String'
|
||||
display leaf-type(n) trim(leaf-value(n))
|
||||
when other
|
||||
display node-type(n)
|
||||
call 'printast' using node-left(n)
|
||||
call 'printast' using node-right(n)
|
||||
end-evaluate
|
||||
.
|
||||
end program printast.
|
||||
end program parser.
|
||||
215
Task/Compiler-syntax-analyzer/Red/compiler-syntax-analyzer.red
Normal file
215
Task/Compiler-syntax-analyzer/Red/compiler-syntax-analyzer.red
Normal file
|
|
@ -0,0 +1,215 @@
|
|||
Red [
|
||||
Title: "Compiler/syntax analyzer"
|
||||
Author: "hinjolicious"
|
||||
]
|
||||
|
||||
#include %lex2-bak.red
|
||||
|
||||
parser: context [
|
||||
lex: copy []
|
||||
ast: copy []
|
||||
row: col: 0
|
||||
tok: none
|
||||
val: none
|
||||
atr: #[
|
||||
EOI #[txt "EOI" ra? no bin? no un? no prec -1 type -1 ]
|
||||
MUL #[txt "*" ra? no bin? yes un? no prec 13 type MUL ]
|
||||
DIV #[txt "/" ra? no bin? yes un? no prec 13 type DIV ]
|
||||
MOD #[txt "%" ra? no bin? yes un? no prec 13 type MOD ]
|
||||
ADD #[txt "+" ra? no bin? yes un? no prec 12 type ADD ]
|
||||
SUB #[txt "-" ra? no bin? yes un? no prec 12 type SUB ]
|
||||
NEG #[txt "-" ra? no bin? no un? yes prec 14 type NEG ]
|
||||
NOT #[txt "!" ra? no bin? no un? yes prec 14 type NOT ]
|
||||
LT #[txt "<" ra? no bin? yes un? no prec 10 type LT ]
|
||||
LEQ #[txt "<=" ra? no bin? yes un? no prec 10 type LEQ ]
|
||||
GT #[txt ">" ra? no bin? yes un? no prec 10 type GT ]
|
||||
GEQ #[txt ">=" ra? no bin? yes un? no prec 10 type GEQ ]
|
||||
EQ #[txt "==" ra? no bin? yes un? no prec 9 type EQ ]
|
||||
NEQ #[txt "!=" ra? no bin? yes un? no prec 9 type NEQ ]
|
||||
ASGN #[txt "=" ra? no bin? no un? no prec -1 type ASGN ]
|
||||
AND #[txt "&&" ra? no bin? yes un? no prec 5 type AND ]
|
||||
OR #[txt "||" ra? no bin? yes un? no prec 4 type OR ]
|
||||
IF #[txt "if" ra? no bin? no un? no prec -1 type IF ]
|
||||
ELSE #[txt "else" ra? no bin? no un? no prec -1 type -1 ]
|
||||
WHILE #[txt "while" ra? no bin? no un? no prec -1 type WHILE]
|
||||
PRINT #[txt "print" ra? no bin? no un? no prec -1 type -1 ]
|
||||
PUTC #[txt "putc" ra? no bin? no un? no prec -1 type -1 ]
|
||||
LP #[txt "(" ra? no bin? no un? no prec -1 type -1 ]
|
||||
RP #[txt ")" ra? no bin? no un? no prec -1 type -1 ]
|
||||
LB #[txt "{" ra? no bin? no un? no prec -1 type -1 ]
|
||||
RB #[txt "}" ra? no bin? no un? no prec -1 type -1 ]
|
||||
SEMI #[txt ";" ra? no bin? no un? no prec -1 type -1 ]
|
||||
COMMA #[txt "," ra? no bin? no un? no prec -1 type -1 ]
|
||||
ID #[txt "identifier" ra? no bin? no un? no prec -1 type ID ]
|
||||
INT #[txt "integer" ra? no bin? no un? no prec -1 type INT ]
|
||||
STR #[txt "string" ra? no bin? no un? no prec -1 type STR ]
|
||||
]
|
||||
|
||||
error: func [msg][
|
||||
print rejoin ["(" row ", " col ") ERROR: " msg]
|
||||
halt
|
||||
]
|
||||
|
||||
gettok: func [][tok: first lex lex: next lex]
|
||||
make-node: func [t l r][compose/only [(t) (l) (r)]]
|
||||
make-leaf: func [t v][compose [(t) (v)]]
|
||||
|
||||
expect: func [msg s][
|
||||
row: tok/1 col: tok/2
|
||||
if tok/3 <> s [
|
||||
error rejoin [msg " expecting '" atr/:s/txt "', found '" atr/(:tok/3)/txt "'"]
|
||||
]
|
||||
gettok
|
||||
]
|
||||
|
||||
expr: func [p /local x][
|
||||
x: none
|
||||
switch to-lit-word tok/3 [
|
||||
'LP [ x: paren-expr ]
|
||||
'ADD [ gettok x: expr atr/ADD/prec ]
|
||||
'SUB [ gettok x: make-node 'NEG expr atr/NEG/prec none ]
|
||||
'NOT [ gettok x: make-node 'NOT expr atr/NOT/prec none ]
|
||||
'ID [ x: make-leaf 'ID tok/4 gettok ]
|
||||
'INT [ x: make-leaf 'INT tok/4 gettok ]
|
||||
;'STR [ x: make-leaf 'STR tok/4 gettok ]
|
||||
][ error rejoin ["Expecting a primary, found '" atr/(:tok/3)/txt "'"] ]
|
||||
|
||||
while [all [atr/(:tok/3)/bin? atr/(:tok/3)/prec >= p]][
|
||||
op: tok/3
|
||||
gettok
|
||||
q: atr/:op/prec
|
||||
;if not atr/:op/ra? [q: q + 1]
|
||||
if atr/:op/ra? [q: q + 1] ; fix!
|
||||
x: make-node atr/:op/type x (expr q)
|
||||
]
|
||||
x
|
||||
]
|
||||
|
||||
paren-expr: func [/local t][
|
||||
expect 'PAREN-EXPR 'LP
|
||||
t: expr 0
|
||||
expect 'PAREN-EXPR 'RP
|
||||
t
|
||||
]
|
||||
|
||||
stmt: func [/local t e s s2 v][
|
||||
t: none row: tok/1 col: tok/2
|
||||
|
||||
switch/default to-lit-word tok/3 [
|
||||
'IF [
|
||||
gettok
|
||||
e: paren-expr s: stmt s2: none
|
||||
if tok/3 = 'ELSE [gettok s2: stmt]
|
||||
t: make-node 'IF e (make-node 'IF s s2)
|
||||
]
|
||||
'PUTC [
|
||||
gettok
|
||||
t: make-node 'PRTC paren-expr none
|
||||
expect 'PUTC 'SEMI
|
||||
]
|
||||
'PRINT [
|
||||
gettok
|
||||
expect 'PRINT 'LP
|
||||
forever [
|
||||
either tok/3 = 'STR [
|
||||
e: make-node 'PRTS (make-leaf 'STR tok/4) none
|
||||
gettok
|
||||
][
|
||||
e: make-node 'PRTI (expr 0) none
|
||||
]
|
||||
t: make-node 'SEQ t e
|
||||
if tok/3 <> 'COMMA [break]
|
||||
gettok
|
||||
]
|
||||
expect 'PRINT 'RP
|
||||
expect 'PRINT 'SEMI
|
||||
]
|
||||
'SEMI [gettok]
|
||||
'ID [
|
||||
v: make-leaf 'ID tok/4
|
||||
gettok
|
||||
expect 'ASSIGN 'ASGN
|
||||
t: make-node 'ASGN v (expr 0)
|
||||
expect 'ASSIGN 'SEMI
|
||||
]
|
||||
'WHILE [
|
||||
gettok
|
||||
t: make-node 'WHILE paren-expr stmt
|
||||
]
|
||||
'LB [
|
||||
expect 'LB 'LB
|
||||
while [all [tok/3 <> 'RB tok/3 <> 'EOI]][
|
||||
t: make-node 'SEQ t stmt
|
||||
]
|
||||
expect 'LB 'RB
|
||||
]
|
||||
'EOI [return t]
|
||||
][ error rejoin ["expecting start of statement, found '" atr/(:tok/3)/txt "'"] ]
|
||||
t
|
||||
]
|
||||
|
||||
parse: func [lx /local t][
|
||||
lex: lx t: none gettok
|
||||
until [
|
||||
t: make-node 'SEQ t stmt
|
||||
any [t = none tok/3 = 'EOI]
|
||||
]
|
||||
ast: t
|
||||
]
|
||||
|
||||
prt-ast: func [t][
|
||||
either t = none[
|
||||
print [";"]
|
||||
][
|
||||
prin [t/1]
|
||||
either any [t/1 = 'ID t/1 = 'INT t/1 = 'STR][
|
||||
print ["^- " either t/1 = 'STR [mold t/2][t/2]]
|
||||
][
|
||||
print ""
|
||||
prt-ast t/2
|
||||
prt-ast t/3
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
flatten-ast: func [t][
|
||||
either t = none[
|
||||
append flt ";^/"
|
||||
][
|
||||
append flt form t/1
|
||||
either any [t/1 = 'ID t/1 = 'INT t/1 = 'STR][
|
||||
append flt rejoin ["^- " form either t/1 = 'STR [mold t/2][t/2] "^/"]
|
||||
][
|
||||
append flt "^/"
|
||||
flatten-ast t/2
|
||||
flatten-ast t/3
|
||||
]
|
||||
]
|
||||
flt
|
||||
]
|
||||
|
||||
save-ast: func [ast fil /flat][
|
||||
flt: copy ""
|
||||
out-fil: replace fil ".lex" ".ast"
|
||||
write out-fil either flat [flatten-ast ast][ast]
|
||||
print ["Saved to" out-fil]
|
||||
]
|
||||
] ; parser context
|
||||
|
||||
parse: :parser/parse
|
||||
save-ast: :parser/save-ast
|
||||
|
||||
test: does [
|
||||
while [(tx: ask "Code: ") <> ""] [
|
||||
if tx = "r" [tx: read request-file]
|
||||
?? tx
|
||||
lx: lex tx
|
||||
?? lx
|
||||
ast: parse lx
|
||||
?? ast
|
||||
parser/prt-ast ast
|
||||
;gen ast
|
||||
;list-code
|
||||
]
|
||||
]
|
||||
test
|
||||
Loading…
Add table
Add a link
Reference in a new issue