Data commit
This commit is contained in:
Ingy döt Net
parent
7387c8f97b
commit
cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
|
|
@ -0,0 +1,407 @@
|
|||
>>SOURCE FORMAT IS FREE
|
||||
*> this code is dedicated to the public domain
|
||||
*> (GnuCOBOL) 2.3-dev.0
|
||||
identification division.
|
||||
program-id. lexer.
|
||||
environment division.
|
||||
configuration section.
|
||||
repository. function all intrinsic.
|
||||
input-output section.
|
||||
file-control.
|
||||
select input-file assign using input-name
|
||||
status input-status
|
||||
organization line sequential.
|
||||
data division.
|
||||
|
||||
file section.
|
||||
fd input-file.
|
||||
01 input-record pic x(98).
|
||||
|
||||
working-storage section.
|
||||
01 input-name pic x(32).
|
||||
01 input-status pic xx.
|
||||
01 input-length pic 99.
|
||||
|
||||
01 output-name pic x(32) value spaces.
|
||||
01 output-status pic xx.
|
||||
01 output-record pic x(64).
|
||||
|
||||
01 line-no pic 999 value 0.
|
||||
01 col-no pic 99.
|
||||
01 col-no-max pic 99.
|
||||
01 col-increment pic 9 value 1.
|
||||
01 start-col pic 99.
|
||||
01 outx pic 99.
|
||||
01 out-lim pic 99 value 48.
|
||||
|
||||
01 output-line value spaces.
|
||||
03 out-line pic zzzz9.
|
||||
03 out-column pic zzzzzz9.
|
||||
03 message-area.
|
||||
05 filler pic xxx.
|
||||
05 token pic x(16).
|
||||
05 out-value pic x(48).
|
||||
05 out-integer redefines out-value pic zzzzz9.
|
||||
05 out-integer1 redefines out-value pic zzzzzz9. *> to match the python lexer
|
||||
|
||||
01 error-record.
|
||||
03 error-line pic zzzz9 value 0.
|
||||
03 error-col pic zzzzzz9 value 0.
|
||||
03 error-message pic x(68) value spaces.
|
||||
|
||||
01 scan-state pic x(16) value spaces.
|
||||
01 current-character pic x.
|
||||
01 previous-character pic x.
|
||||
|
||||
procedure division chaining input-name.
|
||||
start-lexer.
|
||||
if input-name <> spaces
|
||||
open input input-file
|
||||
if input-status = '35'
|
||||
string 'in lexer ' trim(input-name) ' not found' into error-message
|
||||
perform report-error
|
||||
end-if
|
||||
end-if
|
||||
perform read-input-file
|
||||
perform until input-status <> '00'
|
||||
add 1 to line-no
|
||||
move line-no to out-line
|
||||
move length(trim(input-record,trailing)) to col-no-max
|
||||
move 1 to col-no
|
||||
move space to previous-character
|
||||
perform until col-no > col-no-max
|
||||
move col-no to out-column
|
||||
move input-record(col-no:1) to current-character
|
||||
evaluate scan-state
|
||||
|
||||
when 'identifier'
|
||||
if current-character >= 'A' and <= 'Z'
|
||||
or (current-character >= 'a' and <= 'z')
|
||||
or (current-character >= '0' and <= '9')
|
||||
or current-character = '_'
|
||||
perform increment-outx
|
||||
move current-character to out-value(outx:1)
|
||||
if col-no = col-no-max
|
||||
perform process-identifier
|
||||
end-if
|
||||
else
|
||||
perform process-identifier
|
||||
if current-character <> space
|
||||
move 0 to col-increment
|
||||
end-if
|
||||
end-if
|
||||
|
||||
when 'integer'
|
||||
evaluate true
|
||||
when current-character >= '0' and <= '9'
|
||||
perform increment-outx
|
||||
move current-character to out-value(outx:1)
|
||||
if col-no = col-no-max
|
||||
move numval(out-value) to out-integer
|
||||
move 'Integer' to token
|
||||
end-if
|
||||
when current-character >= 'A' and <= 'Z'
|
||||
when current-character >= 'a' and <= 'z'
|
||||
move 'in lexer invalid integer' to error-message
|
||||
perform report-error
|
||||
when other
|
||||
if outx > 5
|
||||
move numval(out-value) to out-integer1 *> to match the python lexer
|
||||
else
|
||||
move numval(out-value) to out-integer
|
||||
end-if
|
||||
move 'Integer' to token
|
||||
if current-character <> space
|
||||
move 0 to col-increment
|
||||
end-if
|
||||
end-evaluate
|
||||
|
||||
when 'comment'
|
||||
if previous-character = '*' and current-character = '/'
|
||||
move 'comment' to token
|
||||
end-if
|
||||
|
||||
when 'quote'
|
||||
evaluate current-character also outx
|
||||
when '"' also 0
|
||||
string 'in lexer empty string' into error-message
|
||||
perform report-error
|
||||
when '"' also any
|
||||
perform increment-outx
|
||||
move current-character to out-value(outx:1)
|
||||
move 'String' to token
|
||||
when other
|
||||
if col-no = col-no-max
|
||||
string 'in lexer missing close quote' into error-message
|
||||
perform report-error
|
||||
else
|
||||
perform increment-outx
|
||||
move current-character to out-value(outx:1)
|
||||
end-if
|
||||
end-evaluate
|
||||
|
||||
when 'character'
|
||||
evaluate current-character also outx
|
||||
when "'" also 0
|
||||
string 'in lexer empty character constant' into error-message
|
||||
perform report-error
|
||||
when "'" also 1
|
||||
subtract 1 from ord(out-value(1:1)) giving out-integer
|
||||
move 'Integer' to token
|
||||
when "'" also 2
|
||||
evaluate true
|
||||
when out-value(1:2) = '\n'
|
||||
move 10 to out-integer
|
||||
when out-value(1:2) = '\\'
|
||||
subtract 1 from ord('\') giving out-integer *> ' (workaround a Rosetta Code highlighter problem)
|
||||
when other
|
||||
string 'in lexer unknown escape sequence ' out-value(1:2)
|
||||
into error-message
|
||||
perform report-error
|
||||
end-evaluate
|
||||
move 'Integer' to token
|
||||
when "'" also any
|
||||
string 'in lexer multicharacter constant' into error-message
|
||||
perform report-error
|
||||
when other
|
||||
if col-no = col-no-max
|
||||
string 'in lexer missing close quote' into error-message
|
||||
perform report-error
|
||||
end-if
|
||||
perform increment-outx
|
||||
move current-character to out-value(outx:1)
|
||||
end-evaluate
|
||||
|
||||
when 'and'
|
||||
evaluate previous-character also current-character
|
||||
when '&' also '&'
|
||||
move 'Op_and' to token
|
||||
when other
|
||||
string 'in lexer AND error' into error-message
|
||||
perform report-error
|
||||
end-evaluate
|
||||
|
||||
when 'or'
|
||||
evaluate previous-character also current-character
|
||||
when '|' also '|'
|
||||
move 'Op_or' to token
|
||||
when other
|
||||
string 'in lexer OR error' into error-message
|
||||
perform report-error
|
||||
end-evaluate
|
||||
|
||||
when 'ambiguous'
|
||||
evaluate previous-character also current-character
|
||||
when '/' also '*'
|
||||
move 'comment' to scan-state
|
||||
subtract 1 from col-no giving start-col
|
||||
when '/' also any
|
||||
move 'Op_divide' to token
|
||||
move 0 to col-increment
|
||||
|
||||
when '=' also '='
|
||||
move 'Op_equal' to token
|
||||
when '=' also any
|
||||
move 'Op_assign' to token
|
||||
move 0 to col-increment
|
||||
|
||||
when '<' also '='
|
||||
move 'Op_lessequal' to token
|
||||
when '<' also any
|
||||
move 'Op_less' to token
|
||||
move 0 to col-increment
|
||||
|
||||
when '>' also '='
|
||||
move 'Op_greaterequal' to token
|
||||
when '>'also any
|
||||
move 'Op_greater' to token
|
||||
move 0 to col-increment
|
||||
|
||||
when '!' also '='
|
||||
move 'Op_notequal' to token
|
||||
when '!' also any
|
||||
move 'Op_not' to token
|
||||
move 0 to col-increment
|
||||
|
||||
when other
|
||||
display input-record
|
||||
string 'in lexer ' trim(scan-state)
|
||||
' unknown character "' current-character '"'
|
||||
' with previous character "' previous-character '"'
|
||||
into error-message
|
||||
perform report-error
|
||||
end-evaluate
|
||||
|
||||
when other
|
||||
move col-no to start-col
|
||||
evaluate current-character
|
||||
when space
|
||||
continue
|
||||
when >= 'A' and <= 'Z'
|
||||
when >= 'a' and <= 'z'
|
||||
move 'identifier' to scan-state
|
||||
move 1 to outx
|
||||
move current-character to out-value
|
||||
when >= '0' and <= '9'
|
||||
move 'integer' to scan-state
|
||||
move 1 to outx
|
||||
move current-character to out-value
|
||||
when '&'
|
||||
move 'and' to scan-state
|
||||
when '|'
|
||||
move 'or' to scan-state
|
||||
when '"'
|
||||
move 'quote' to scan-state
|
||||
move 1 to outx
|
||||
move current-character to out-value
|
||||
when "'"
|
||||
move 'character' to scan-state
|
||||
move 0 to outx
|
||||
when '{'
|
||||
move 'LeftBrace' to token
|
||||
when '}'
|
||||
move 'RightBrace' to token
|
||||
when '('
|
||||
move 'LeftParen' to token
|
||||
when ')'
|
||||
move 'RightParen' to token
|
||||
when '+'
|
||||
move 'Op_add' to token
|
||||
when '-'
|
||||
move 'Op_subtract' to token
|
||||
when '*'
|
||||
move 'Op_multiply' to token
|
||||
when '%'
|
||||
move 'Op_mod' to token
|
||||
when ';'
|
||||
move 'Semicolon' to token
|
||||
when ','
|
||||
move 'Comma' to token
|
||||
when '/'
|
||||
when '<'
|
||||
when '>'
|
||||
when '='
|
||||
when '='
|
||||
when '<'
|
||||
when '>'
|
||||
when '!'
|
||||
move 'ambiguous' to scan-state
|
||||
when other
|
||||
string 'in lexer unknown character "' current-character '"'
|
||||
into error-message
|
||||
perform report-error
|
||||
end-evaluate
|
||||
end-evaluate
|
||||
|
||||
if token <> spaces
|
||||
perform process-token
|
||||
end-if
|
||||
|
||||
move current-character to previous-character
|
||||
add col-increment to col-no
|
||||
move 1 to col-increment
|
||||
end-perform
|
||||
if scan-state = 'ambiguous'
|
||||
evaluate previous-character
|
||||
when '/'
|
||||
move 'Op_divide' to token
|
||||
perform process-token
|
||||
|
||||
when '='
|
||||
move 'Op_assign' to token
|
||||
perform process-token
|
||||
|
||||
when '<'
|
||||
move 'Op_less' to token
|
||||
perform process-token
|
||||
|
||||
when '>'
|
||||
move 'Op_greater' to token
|
||||
perform process-token
|
||||
|
||||
when '!'
|
||||
move 'Op_not' to token
|
||||
perform process-token
|
||||
|
||||
when other
|
||||
string 'in lexer unresolved ambiguous
|
||||
"' previous-character '" at end of line'
|
||||
into error-message
|
||||
perform report-error
|
||||
end-evaluate
|
||||
end-if
|
||||
perform read-input-file
|
||||
end-perform
|
||||
|
||||
evaluate true
|
||||
when input-status <> '10'
|
||||
string 'in lexer ' trim(input-name) ' invalid input status ' input-status
|
||||
into error-message
|
||||
perform report-error
|
||||
when scan-state = 'comment'
|
||||
string 'in lexer unclosed comment at end of input' into error-message
|
||||
perform report-error
|
||||
end-evaluate
|
||||
|
||||
move 'End_of_input' to token
|
||||
move 1 to out-column
|
||||
move 1 to start-col
|
||||
add 1 to line-no
|
||||
perform process-token
|
||||
|
||||
close input-file
|
||||
stop run
|
||||
.
|
||||
process-identifier.
|
||||
evaluate true
|
||||
when out-value = 'print'
|
||||
move 'Keyword_print' to token
|
||||
move spaces to out-value
|
||||
when out-value = 'while'
|
||||
move 'Keyword_while' to token
|
||||
move spaces to out-value
|
||||
when out-value = 'if'
|
||||
move 'Keyword_if' to token
|
||||
move spaces to out-value
|
||||
when out-value = 'else'
|
||||
move 'Keyword_else' to token
|
||||
move spaces to out-value
|
||||
when out-value = 'putc'
|
||||
move 'Keyword_putc' to token
|
||||
move spaces to out-value
|
||||
when other
|
||||
move 'Identifier' to token
|
||||
end-evaluate
|
||||
.
|
||||
increment-outx.
|
||||
if outx >= out-lim
|
||||
string 'in lexer token value length exceeds ' out-lim into error-message
|
||||
perform report-error
|
||||
end-if
|
||||
add 1 to outx
|
||||
.
|
||||
process-token.
|
||||
if token <> 'comment'
|
||||
move start-col to out-column
|
||||
move line-no to out-line
|
||||
display output-line
|
||||
end-if
|
||||
move 0 to start-col
|
||||
move spaces to scan-state message-area
|
||||
.
|
||||
report-error.
|
||||
move line-no to error-line
|
||||
move start-col to error-col
|
||||
display error-record
|
||||
close input-file
|
||||
stop run with error status -1
|
||||
.
|
||||
read-input-file.
|
||||
if input-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
|
||||
.
|
||||
end program lexer.
|
||||
Loading…
Add table
Add a link
Reference in a new issue