makeparse.p

PL/0源码

(*=====================================

    MAKEPARSE

    Reads ptablebin, etablebin, and index files produced by fmq and
    writes C variable definitions on standard output for appropriate
    tables to be linked into the parser.

======================================*)

program makeparse (ptablebin, etablebin, output);

#include "scanner.h"

const
    {required sizes for the following can be gleaned from
    statistics output of FMQ}

    MAX_PROD_SPACE      = 1000; {size of array for productions}
    MAX_SYM             = 250;  {number of syms (term+nonterm) in grammar}
    MAX_STRING          = 3000; {total length of all symbol names}
    MAX_PROD            = 300;  {number of productions in grammar}
    MAX_INSERT_SPACE    = 2000; {size of array for insertion strings}

type
    name = varying[12] of char;
    PrSpaceIndex = 0..MAX_PROD_SPACE;
    ProdIndex = 0..MAX_PROD;
    ProdRec = record {one production in the grammar}
        start,  {pointer into production space}
        length : PrSpaceIndex; {number of symbols in production}
    end;
    SymIndex = 0..MAX_SYM;
    ParseAction = -MAX_PROD..MAX_PROD;
    InsSpaceIndex = 0..MAX_INSERT_SPACE;
    InsertString = record
        first, last : InsSpaceIndex;
        cost : integer;
    end;
    SparseTablePtr = ^SparseTableRec;
    SparseTableType = (PARSE_TABLE, PREFIX_TABLE);
    SparseTableRec = record
        next : SparseTablePtr;
        term : SymIndex;
        case SparseTableType of
            PARSE_TABLE: (
                pAct : ParseAction;
            );
            PREFIX_TABLE : (
                insertion : InsertString;
            );
    end;
    SparseTable = array[SymIndex] of SparseTablePtr;
    StringIndex = 0..MAX_STRING;
    StringRec = record
        start, length : StringIndex;
    end;

var
    numProds, numSymbols : integer;

    productions : array[ProdIndex] of ProdRec;      {indices into prodSpace}
    prodSpace : array[PrSpaceIndex] of integer;
    prodSpacePtr : PrSpaceIndex;
    table : SparseTable;
    epsilonProd : array[ProdIndex] of Boolean;
    symTab : array[SymIndex] of StringRec;

    {variables for error correction:}

    parserNumTerms,
    infinity : integer;             {ridiculously high correction cost}

    costTable : array[SymIndex] of InsertString;
    deleteCosts : array[MajorTokenNum] of integer;
    insertSpace : array[InsSpaceIndex] of MajorTokenNum;
    prefixTable : SparseTable;

    parserStringSpace : array[StringIndex] of char;
    
    ptablebin, etablebin : file of integer;
    stringPtr: integer;             (*last used index in parserStringSpace*)
    insertPtr : InsSpaceIndex;      (*last used index in insertSpace*)
    n : integer;

(********
    prepare to generate temporary names
 ********)

procedure InitNames (i : integer);
begin
    n := i;
end; (*InitNames*)

(********
    make a new name
 ********)

function NextName : name;
var
    rtn : name;
    k : integer;
begin
    rtn := '';
    k := n;
    n := n + 1;
    while k > 0 do begin
        rtn := chr ((k mod 10) + ord ('0')) + rtn;
        k := k div 10;
    end;
    NextName := 'row' + rtn;
end; (*NextName*)

(********
    produce C generate_code initialized globals for all static variables
 ********)

procedure OutputTables;
var
    i, j, nSave : integer;
    temp : SparseTablePtr;
    nm : name;
begin
    writeln('#include "parsetab.h"');

    writeln ('bool pt_epsilon_prod[] = {');
    write (BLANK);
    for i := 0 to numProds do begin
        if i <> 0 then
            write (' ,');
        write (epsilonProd[i]);
        if i mod 10 = 9 then
            writeln;
    end; (*for*)
    writeln ('};');
    
    writeln ('int pt_num_terminals = ', parserNumTerms:1, ';');
    writeln ('int pt_num_productions = ', numProds:1, ';');
    writeln ('int pt_num_symbols = ', numSymbols:1, ';');
    writeln ('production_t pt_productions[] = {');
    for i := 0 to numProds do
        with productions[i] do begin
            write (' {', start:1, ', ', length:1, '}');
            if i = numProds then
                writeln ('};')
            else
                writeln (',');
        end; (*with*)
    writeln ('int pt_prod_space[] = {', prodSpace[0]:1);
    for i := 1 to MAX_PROD_SPACE do begin
        write (' ,', prodSpace[i]:1);
        if i mod 10 = 0 then
            writeln;
    end; (*for*)
    writeln ('};');
    writeln ('prod_sindex_t pt_prod_space_ptr = ', prodSpacePtr:1, ';');
    InitNames (1);
    for i := 0 to MAX_SYM do begin
        temp := table[i];
        if temp <> nil then begin
            j := 1;
            nm := NextName;
            write ('static sparse_table_t ', nm, '[] = {');
            while temp <> nil do
                with temp^ do begin
                    write (' {');
                    if next = nil then (* next *)
                        write ('0, ')
                    else
                        write (nm, '+', j:1, ', ');
                    write (term:1, ', ', pAct:1, ', {0, 0, 0}}');
                    if next = nil then
                        writeln ('};')
                    else
                        writeln (',');
                    j := j + 1;
                    temp := next;
                end; (*with*)
        end;
    end;
    InitNames (1);
    writeln ('sparse_table_t *pt_table[] = {');
    write (BLANK);
    for i := 0 to MAX_SYM do begin
        if i <> 0 then
            write (' ,');
        if table[i] = nil then
            write ('0')
        else
            write (NextName);
        if i mod 5 = 4 then
            writeln;
    end; (*for*)
    writeln ('};');
    writeln ('symbol_string_t pt_symbol_table[] = {');
    write (BLANK);
    for i := 0 to numSymbols do begin
        if i <> 0 then
            write (' ,');
        with symTab[i] do
            writeln ('{', start:1, ', ', length:1, '}');
    end; (*for*)
    writeln ('};');

    writeln ('int pt_infinity = ', infinity:1, ';');
    writeln ('int pt_insert_ptr = ', insertPtr:1, ';');
    writeln ('int pt_delete_costs[] = {', deleteCosts[0]:1);
    for i := 1 to parserNumTerms do begin
        write (' ,', deleteCosts[i]:1);
        if i mod 10 = 0 then
            writeln;
    end; (*for*)
    writeln ('};');
    writeln ('major_token_t pt_insert_space[] = { ', insertSpace[0]:1);
    for i := 1 to MAX_INSERT_SPACE do begin
        write (' ,', insertSpace[i]:1);
        if i mod 5 = 0 then
            writeln;
    end; (*for*)
    writeln ('};');
    writeln ('char pt_string_space[] = {');
    for i := 0 to stringPtr do begin
        write ('''', parserStringSpace[i], ''', ');
        if i mod 15 = 14 then
            writeln;
    end;
    writeln ('''\0''};');
    nSave := n;
    for i := 0 to MAX_SYM do begin
        temp := prefixTable[i];
        if temp <> nil then begin
            j := 1;
            nm := NextName;
            write ('static sparse_table_t  ', nm, '[] = {');
            while temp <> nil do
                with temp^ do begin
                    write (' {');
                    if next = nil then
                        write ('0, ')
                    else
                        write (nm, '+', j:1, ', ');
                    write (term:1, ', 0, {', insertion.first:1, ', ',
                        insertion.last:1, ', ', insertion.cost:1, '}}');
                    if next = nil then
                        writeln ('};')
                    else
                        writeln (',');
                    j := j + 1;
                    temp := next;
                end; (*with*)
        end;
    end;
    InitNames (nSave);
    writeln ('sparse_table_t * pt_prefix_table[] = {');
    write (BLANK);
    for i := 0 to MAX_SYM do begin
        if i <> 0 then
            write (' ,');
        if prefixTable[i] = nil then
            write ('0')
        else begin
            nm := NextName;
            write (nm);
        end;
        if i mod 5 = 4 then
            writeln;
    end; (*for*)
    writeln ('};');
    
    writeln ('insert_string_t pt_cost_table[] = {');
    for i := 0 to numSymbols do
        with costTable[i] do begin
            write (' {', first:1, ', ', last:1, ', ', cost:1, '}');
            if i = numSymbols then
                writeln ('};')
            else
                writeln (',');
        end; (*with*)
    
end; (*OutputTables*)

(********
    initialize the table to all nils
 ********)

procedure InitPtab;
var
    sym: SymIndex;
begin
    for sym := 1 to MAX_SYM do
        table[sym] := nil;
end; (*InitPtab*)

(********
    read in the various tables.
 ********)

procedure ReadTables;

var
    sym: SymIndex;
    termSym: integer;
    pAction: integer;
    ptr: SparseTablePtr;
    prod: integer;
    i, j: integer;
    len: integer;
    epCount: integer;

begin
    reset (ptablebin);

    read (ptablebin, parserNumTerms, numSymbols, numProds, stringPtr);
    read (ptablebin, i);
    assert (i = ord ('T'));
    assert (numSymbols <= MAX_SYM);
    assert (parserNumTerms <= MAX_MAJOR_TOKEN_NUM);
    assert (numProds <= MAX_PROD);
    assert (stringPtr <= MAX_STRING);

    for prod := 1 to numProds do
    with productions [prod] do begin
        read (ptablebin, len);
        length := len;
        start := prodSpacePtr+1;
        for i := 1 to length do begin
            read (ptablebin, j);
            prodSpacePtr := prodSpacePtr + 1;
            prodSpace[prodSpacePtr] := j;
        end;
    end;

    InitPtab;
    read (ptablebin, termSym, pAction);
    for sym := parserNumTerms + 1 to numSymbols do begin
        assert ((termSym = 0) and (pAction = sym));
        read (ptablebin, termSym, pAction);
        while termSym <> 0 do begin
            new (ptr);
            with ptr^ do begin
                term := termSym;
                pAct := pAction;
                next := table[sym];
            end;
            table[sym] := ptr;
            read (ptablebin, termSym, pAction);
        end;
    end;

    read (ptablebin, epCount);
    for prod := 1 to numProds do epsilonProd[prod] := false;
    for i := 1 to epCount do begin
        read (ptablebin, prod);
        epsilonProd[prod] := true;
    end;

    for sym := 1 to numSymbols do begin
        read (ptablebin, i, j);
        symTab[sym].start := i;
        symTab[sym].length := j;
    end;

    parserStringSpace[0] := ' ';
    for i := 1 to stringPtr do begin
        read (ptablebin, j);
        if j = 0 then j := ord (BLANK);
            (*fmq seems to produce just one of these, after $$$ --mls 6-5-92*)
        parserStringSpace[i] := chr (j);
    end;

end; (*ReadTables*)

(********
    read the correction costs for the terminals
 ********)

procedure ReadCosts;
var
    term: MajorTokenNum;
    c, d: integer;
begin
    for term := 1 to parserNumTerms do
        with costTable[term] do begin
            read (etablebin, c, d);
            deleteCosts[term] := d;
            cost := c;
            insertPtr := insertPtr + 1;
            first := insertPtr;
            last := insertPtr;
            insertSpace[insertPtr] := term;
        end;
end; (*ReadCosts*)

(********
    read in the S table -- least cost strings derivable from non-terminals
 ********)

procedure ReadS;
var
    sym: SymIndex;
    length: integer;
    i: integer;
begin
    for sym := parserNumTerms+1 to numSymbols do
        with costTable[sym] do begin
            read (etablebin, cost, length);
            assert (insertPtr + length <= MAX_INSERT_SPACE);
            first := insertPtr + 1;
            for i := 1 to length do begin
                insertPtr := insertPtr + 1;
                read (etablebin, insertSpace[insertPtr]);
            end;
            last := insertPtr;
        end; (*with*)
end; (*ReadS*)

(********
    read in the E table -- least cost prefixes to derive terminals from
    non-terminals
 ********)

procedure ReadE;
var
    term : SymIndex;
    i, a, b, c : integer;
    p : SparseTablePtr;
begin
    for i := 1 to parserNumTerms do begin
        (*can derive self at zero cost*)
        new (p);
        p^.next := nil;
        prefixTable[i] := p;
        p^.term := i;
        p^.insertion.cost := 0;
        p^.insertion.first := 2;    
        p^.insertion.last := 1;     (*no length*)
    end;
    for i := parserNumTerms+1 to numSymbols do
        prefixTable[i] := nil;
    while true do begin
        read (etablebin, a, b, c);
        if (a = 0) and (b = 0) and (c = 0) then
            return;
        if a = 0 then begin         (*change in symbol to derive from*)
            term := b;
            assert (c = 0);
        end
        else begin                  (*another terminal to derive*)
            new (p);
            p^.next := prefixTable[a];
            prefixTable[a] := p;
            p^.term := term;
            p^.insertion.cost := b;
            p^.insertion.first := insertPtr + 1;
            for i := 1 to c do begin
                insertPtr := insertPtr + 1;
                read (etablebin, insertSpace[insertPtr]);
            end;
            p^.insertion.last := insertPtr;
        end;
    end; (*while true*)
end; (*ReadE*)

(********
    read in all the error table info
 ********)

procedure ReadErrTables;
var
    sym: integer;
    term: integer;
begin
    reset (etablebin);
    read (etablebin, term, sym, infinity);
    assert (sym = numSymbols);
    assert (term = parserNumTerms);
    insertPtr := 0;
    ReadCosts;
    ReadS;
    ReadE;
end; (*ReadErrTables*)

begin (*main*)
    ReadTables;
    ReadErrTables;
    OutputTables;
end.