Data update
This commit is contained in:
Ingy döt Net
parent
4bb20c9b71
commit
cbaf4c4b64
12390 changed files with 318560 additions and 27248 deletions
233
Task/Compiler-lexical-analyzer/Red/compiler-lexical-analyzer.red
Normal file
233
Task/Compiler-lexical-analyzer/Red/compiler-lexical-analyzer.red
Normal file
|
|
@ -0,0 +1,233 @@
|
|||
Red [
|
||||
Title: "Compiler/lexical analyzer"
|
||||
Author: "hinjolicious"
|
||||
]
|
||||
|
||||
LEXER: context [
|
||||
|
||||
is-space: function [c][find "^/^- " c]
|
||||
is-varchars: function [c][find "abcdefghijklmnopqrstuvwxyz0123456789_" lowercase c]
|
||||
is-digit: function [c][find "0123456789" c]
|
||||
|
||||
source: object [
|
||||
txt: copy "" len: 0 row: 1 col: ix: 0 ch: ""
|
||||
|
||||
open: func [fil][
|
||||
txt: read fil len: length? txt row: 1 col: ix: 0 ch: ""
|
||||
source
|
||||
]
|
||||
read-text: func [tx][
|
||||
txt: copy tx len: length? txt row: 1 col: ix: 0 ch: ""
|
||||
source
|
||||
]
|
||||
getc: does [
|
||||
ix: ix + 1 col: col + 1
|
||||
either ix <= len [
|
||||
ch: to-string txt/:ix
|
||||
if ch = "^/" [row: row + 1 col: 0]
|
||||
][ch: ""]
|
||||
ch
|
||||
]
|
||||
] ; /source
|
||||
|
||||
lex: object [
|
||||
list: copy []
|
||||
|
||||
analyze: does [
|
||||
source/getc
|
||||
until [token/get-tok token/id = 'EOI]
|
||||
list
|
||||
]
|
||||
|
||||
show: does [
|
||||
foreach t list [
|
||||
r: t/1 c: t/2 id: t/3 val: either string? t/4 [copy t/4][t/4]
|
||||
prin [pad r 3 pad c 3 pad id 10
|
||||
pad either id = 'STR [mold val][val] 20 "^/"]
|
||||
]
|
||||
]
|
||||
|
||||
save-to-file: func [fil][
|
||||
out: copy ""
|
||||
foreach t list [
|
||||
append out
|
||||
rejoin [pad t/1 5 pad t/2 5 pad t/3 20
|
||||
pad case [t/3 = 'STR [mold t/4] true [t/4]] 20 "^/"]
|
||||
]
|
||||
out-fil: replace fil ".t" ".out"
|
||||
write out-fil out
|
||||
print ["Saved to " out-fil]
|
||||
]
|
||||
save-lex: func [fil][
|
||||
out-fil: replace fil ".t" ".lex"
|
||||
write out-fil list
|
||||
print ["Saved to " out-fil]
|
||||
]
|
||||
]
|
||||
|
||||
token: object [
|
||||
id: val: none row: col: 0
|
||||
id-type: #[
|
||||
"if" 'IF
|
||||
"else" 'ELSE
|
||||
"while" 'WHILE
|
||||
"print" 'PRINT
|
||||
"putc" 'PUTC
|
||||
]
|
||||
|
||||
ident-type: func [txt][
|
||||
typ: id-type/:txt
|
||||
either typ [new typ ""][new 'ID txt]
|
||||
]
|
||||
|
||||
new: func [t v] [
|
||||
id: t val: v
|
||||
append/only lex/list compose [(row) (col) (t) (v)]
|
||||
token
|
||||
]
|
||||
|
||||
get-tok: does [
|
||||
while [is-space source/ch][source/getc]
|
||||
row: source/row col: source/col
|
||||
switch/default source/ch [
|
||||
"*" [source/getc new 'MUL ""]
|
||||
"%" [source/getc new 'MOD ""]
|
||||
"+" [source/getc new 'ADD ""]
|
||||
"-" [source/getc new 'SUB ""]
|
||||
"<" [source/getc follow "=" 'LEQ 'LT]
|
||||
">" [source/getc follow "=" 'GEQ 'GT]
|
||||
"=" [source/getc follow "=" 'EQ 'ASGN]
|
||||
"!" [source/getc follow "=" 'NEQ 'NOT]
|
||||
"&" [source/getc follow "&" 'AND 'EOI]
|
||||
"|" [source/getc follow "|" 'OR 'EOI]
|
||||
"(" [source/getc new 'LP ""]
|
||||
")" [source/getc new 'RP ""]
|
||||
"{" [source/getc new 'LB ""]
|
||||
"}" [source/getc new 'RB ""]
|
||||
";" [source/getc new 'SEMI ""]
|
||||
"," [source/getc new 'COMMA ""]
|
||||
"/" [source/getc div-comment]
|
||||
"'" [source/getc char-lit]
|
||||
{"} [string-lit]
|
||||
"" [new 'EOI ""]
|
||||
][ident-int]
|
||||
]
|
||||
|
||||
div-comment: does [
|
||||
if source/ch <> "*" [return new 'DIV ""]
|
||||
source/getc
|
||||
forever [
|
||||
switch/default source/ch [
|
||||
"*" [
|
||||
if source/getc = "/" [
|
||||
source/getc
|
||||
return get-tok
|
||||
]
|
||||
]
|
||||
"" [error "EOF in comment"]
|
||||
][source/getc]
|
||||
]
|
||||
new 'COMMENT ""
|
||||
]
|
||||
|
||||
error: func [msg][
|
||||
print [row col msg source/ch]
|
||||
halt
|
||||
]
|
||||
|
||||
ident-int: does [
|
||||
is-number: true
|
||||
text: copy ""
|
||||
while [is-varchars source/ch][
|
||||
append text source/ch
|
||||
unless is-digit source/ch [is-number: false]
|
||||
source/getc
|
||||
]
|
||||
if (length? text) = 0 [
|
||||
error "token/get-tok: unrecognized character"
|
||||
]
|
||||
if is-digit text/1 [
|
||||
unless is-number [
|
||||
error "invalid number:" text
|
||||
]
|
||||
n: to-integer text
|
||||
if n > 2147483647 [error "number exceeds maximum value"]
|
||||
if n < -2147483648 [error "number exceeds minimum value"]
|
||||
return new 'INT n
|
||||
]
|
||||
ident-type text
|
||||
]
|
||||
|
||||
char-lit: does [
|
||||
case [
|
||||
source/ch = "'" [error "token/get-tok: empty character constant"]
|
||||
source/ch = "\" [
|
||||
switch/default source/getc [
|
||||
"n" [n: 10]
|
||||
"\" [n: to-integer #"\"]
|
||||
][error "token/get-tok: uknown escape sequence"]
|
||||
]
|
||||
source/ch = " " [n: 32]
|
||||
true [ n: to-integer to-char source/ch ]
|
||||
]
|
||||
if source/getc <> "'" [error "multi-character constant"]
|
||||
source/getc
|
||||
new 'INT n
|
||||
]
|
||||
|
||||
string-lit: does [
|
||||
text: copy ""
|
||||
while [source/getc <> {"}][
|
||||
if source/ch = "\n" [error "EOL in string" ""]
|
||||
if source/ch = "" [error "EOF in string" ""]
|
||||
append text source/ch
|
||||
]
|
||||
source/getc
|
||||
new 'STR text
|
||||
]
|
||||
|
||||
follow: func [ex tok-yes tok-no][
|
||||
if source/ch = ex [
|
||||
source/getc
|
||||
return new tok-yes ""
|
||||
]
|
||||
if tok-no = 'EOI [error "follow: unrecognized character"]
|
||||
new tok-no ""
|
||||
]
|
||||
] ; /token
|
||||
|
||||
_lex: func [tx][
|
||||
clear lex/list
|
||||
source/read-text tx
|
||||
lex/analyze
|
||||
]
|
||||
] ; /LEXER context
|
||||
|
||||
lex: :lexer/_lex
|
||||
prt-lex: :lexer/lex/show
|
||||
|
||||
test: func [][
|
||||
inp: copy "" fil: copy "" lx: copy []
|
||||
forever [
|
||||
print ["Code:" inp]
|
||||
print ["File:" fil]
|
||||
print ["Lex:" lx]
|
||||
print "Type code or 'r' to read from file, 's' to save, 'q' to quit."
|
||||
inp: ask "Code: "
|
||||
if inp = "q" [quit]
|
||||
if inp = "r" [
|
||||
fil: request-file
|
||||
print "Source:" fil
|
||||
inp: read fil
|
||||
]
|
||||
if inp = "s" [
|
||||
if lx = [] [print "Lex is empty!" continue]
|
||||
fil: request-file
|
||||
write fil lx
|
||||
continue
|
||||
]
|
||||
lx: lex inp
|
||||
prt-lex lx
|
||||
]
|
||||
]
|
||||
;test
|
||||
Loading…
Add table
Add a link
Reference in a new issue