'Copyright Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'tsgen.bas - Token Symbol Generator-generator
'Create datatables used by the tokenisation engine.
'
'A token symbol (refered to as TS) is the next level of parsing above characters in a file.
'Identification of such things can be done by looking at the character stream only (i.e no symbol-table
'lookups etc.) and so are produced by a state machine.
'
'This program takes an input file (syntax described below) and produces a series of DATA statements
'that can be compiled into the tokenisation engine. It also produces CONST declarations of the TS's.
'
'The input file (extension .ts) is structured as a series of directives and rules. Directives begin with
'a % character, rules begin with a alpha-num word. Directives:
'
' %class myclass = abcd
'Defines a set of characters called myclass consisting of the characters a, b, c and d. A class is used
'to mean "any character in that class". Punctuation characters may have special meanings in rules; the
'literal character can be specified by defining a class consisting only of it. A backslash (\) followed
'by two characters specifies an ASCII code in hexadecimal.
'
'Rules:
'A rule specifies what to do when a character or set of characters is seen in a particular state. The
'full syntax for a rule is:
' current_state: character_specifier ~ new_state [{!|&} TS]
'Note: {!|&} indicates either ! or &. [] indicates an optional element.
'
'A rule states that when in <current state>, the occurance of a character (ar any of a set of characters)
'triggers a transition to <new state>, optionally also generating a TS <completed TS name>.
'
'current_state and new_state are state names, a simple alpha-numeric name. No need to declare states, they
'exist as soon as a rule uses them.
'
'character_specifier is one of:
' A character class, denoted as $myclass
' The double quote character (") followed by a single character indicating just that character, literally.
' An asterisk (*) to specify any character
'
' If given, TS is the name of the TS to be generated by this rule.
' ! and & specify the buffer behaviour (see below).
'
'The engine reads the file character by character, starting in the Begin state. For a given state, the
'engine looks at all rules for that state and picks one based on the character specifier; rules are
'stacked, so later rules have precedence over earlier rules. Generally the first rule for a state is a
'catch-all * rule, then more specific rules follow.
'
'Upon choosing a rule, the input character is added to the buffer and the engine transitions to the new
'state specified. If no TS is given, this ends the process, which then repeats. If a TS is given using the
'! marker, a TS with the given name is returned, and its value is that of the buffer. The buffer is then
'emptied and the process repeats. If instead the & marker is used, the character just processed is
'removed from the buffer and placed back into the input stream before the TS is returned. The process
'then repeats and this character is read again.
'
'Special states:
' Begin: the initial state
' Error: transitioning to this state causes an error to be generated
'Special TS:
' SKIP: returning the SKIP TS does not actually generate a TS, but empties the buffer as if it were (&
' special behaviour also applies).
'
'Blank lines are ignored. Comments may be given with # on their own line.


$console:only
_dest _console
on error goto ehandler
chdir _startdir$

redim shared classnames$(0)
redim shared classvalues$(0)
redim shared states%(127, 1)
redim shared statenames$(1)
redim shared tokennames$(2)

statenames$(0) = "Error"
statenames$(1) = "Begin"
tokennames$(1) = "SKIP"

if _commandcount <> 3 then
    print "Usage: "; command$(0); " "; "<input file> <output header file> <output module file>"
    system 1
end if

if not _fileexists(command$(1)) then
    print command$(0); ": Cannot open "; command$(1)
    system 1
end if

open command$(1) for input as #1
open command$(2) for output as #2
open command$(3) for output as #3

do while not eof(1)
    linenum = linenum + 1
    line input #1, l$
    if len(l$) then
        c1$ = left$(l$, 1)
        if c1$ = "%" then
            gosub directive
        elseif instr("# " + chr$(9), c1$) then
            rem
        elseif instr("abcdefghijklmnopqrstuvwxyz0123456789", lcase$(c1$)) then
            gosub rule
        else
            e$ = "Syntax error"
            gosub fatalerror
        end if
    end if
loop

for i& = 1 to ubound(tokennames$) - 1
    print #2, "CONST TS_"; tokennames$(i&); " ="; i&
next i&
print #2, "CONST TS_MAX ="; ubound(tokennames$) - 1
for i& = 1 to ubound(statenames$) - 1
    print #2, "CONST TS_ST_"; statenames$(i&); " ="; i&
next i&
print #2, "DIM SHARED t_states~%(127,"; str$(ubound(states%, 2) - 1); ")"
print #2, "DIM SHARED t_statenames$("; ltrim$(str$(ubound(statenames$) - 1)); ")"

for i& = 1 to ubound(states%, 2) - 1
    print #3, "DATA "; chr$(34); statenames$(i&); chr$(34); ",";
    for j& = 1 to 126
        print #3, ltrim$(str$(states%(j&, i&))); ",";
    next j&
    print #3, ltrim$(str$(states%(127, i&)))
next i&
system
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
ehandler:
    print err; _errorline
    system 1
 
directive:
    equals = instr(l$, "=")
    sp = instr(l$, " ")
    dir$ = rtrim$(mid$(l$, 2, sp - 1))
    select case dir$
        case "class"
            cname$ = ltrim$(rtrim$(mid$(l$, sp, equals - sp - 1)))
            cvalue$ = ltrim$(rtrim$(mid$(l$, equals + 1)))
            add_class cname$, cvalue$
        case else
            e$ = "Unknown directive " + dir$
            gosub fatalerror
    end select
return

rule:
    colon = instr(l$, ":")
    tilde = instr(l$, "~")
    bang = instr(l$, "!")
    amp = instr(l$, "&")
    ending = len(l$)
    toktype = 0
    if bang > 0 then ending = bang - 1: toktype = 1
    if amp > 0 then ending = amp - 1: toktype = 2
    state$ = rtrim$(left$(l$, colon - 1))
    chars$ = resolve_charref$(ltrim$(rtrim$(mid$(l$, colon + 1, tilde - colon - 1))))
    newstate$ = ltrim$(rtrim$(mid$(l$, tilde + 1, ending - tilde)))
    if toktype then token$ = ltrim$(rtrim$(mid$(l$, ending + 2)))
    state_id%% = get_state_id(state$)
    new_state_id%% = get_state_id(newstate$)
    token_id%% = 0
    if toktype then token_id%% = get_token_id(token$)
    'print state_id%%, new_state_id%%, toktype, token_id%%
    v~% = (new_state_id%% * 2^8) or token_id%%
    if toktype = 2 then v~% = v~% or 128
    for i& = 1 to len(chars$)
        states%(asc(chars$, i&), state_id%%) = v~%
    next i&
return

fatalerror:
    print command$(0); ": "; command$(1); ":"; ltrim$(str$(linenum)); ": "; e$
    system 1
    return

sub add_class(cname$, cvalue$)
    classnames$(ubound(classnames$)) = cname$
    classvalues$(ubound(classvalues$)) = expand_escapes$(cvalue$)
    redim _preserve classnames$(ubound(classnames$) + 1)
    redim _preserve classvalues$(ubound(classvalues$) + 1)
end sub

function get_state_id(state$)
    for i& = 0 to ubound(statenames$) - 1
        if statenames$(i&) = state$ then get_state_id = i&: exit function
    next i&
    statenames$(ubound(statenames$)) = state$
    redim _preserve statenames$(ubound(statenames$) + 1)
    redim _preserve states%(127, ubound(states%, 2) + 1)
    get_state_id = ubound(statenames$) - 1
end function

function get_token_id(token$)
    for i& = 0 to ubound(tokennames$) - 1
        if tokennames$(i&) = token$ then get_token_id = i&: exit function
    next i&
    tokennames$(ubound(tokennames$)) = token$
    redim _preserve tokennames$(ubound(tokennames$) + 1)
    get_token_id = ubound(tokennames$) - 1
end function

function expand_escapes$ (in$)
for i& = 1 to len(in$)
    if mid$(in$, i&, 1) = "\" and i& + 2 <= len(in$) then '"
        o$ = o$ + chr$(val("&h" + mid$(in$, i& + 1, 2)))
        i& = i& + 2
    else
        o$ = o$ + mid$(in$, i&, 1)
    end if
next i&
expand_escapes$ = o$
end function

function resolve_charref$(raw$)
    select case left$(raw$, 1)
        case chr$(34)
            resolve_charref$ = mid$(raw$, 2, 1)
        case "$"
            cname$ = mid$(raw$, 2)
            for i& = 0 to ubound(classnames$) - 1
                if classnames$(i&) = cname$ then resolve_charref$ = classvalues$(i&): exit for
            next i&
        case "*"
            for i& = 1 to 127
                s$ = s$ + chr$(i&)
            next i&
            resolve_charref$ = s$
    end select
end function
