Columbia Kermit/kermit.zip/pub/ucsdterak/parser.text

Text File | 2020-01-01 | 10KB | 327 lines

(*$S+*)
unit parser;

INTERFACE

type statustype = (null, at_eol, unconfirmed, parm_expected, ambiguous,
                   unrec, fn_expected, ch_expected);
     vocab = (nullsym, allsym, consym, debugsym, escsym, evensym, exitsym,
              filewarnsym,helpsym, ibmsym, localsym, marksym, nonesym,
              oddsym, offsym, onsym, paritysym, quitsym, recsym, sendsym,
              setsym, showsym, spacesym);

var noun, verb, adj: vocab;
    status: statustype;
    vocablist: array[vocab] of string;
    filename, line: string;
    newescchar: char;
    expected: set of vocab;

procedure uppercase(var s: string);

function parse: statustype;

procedure initvocab;

IMPLEMENTATION

procedure uppercase(*var s: string*);

var i: integer;

  begin
    for i := 1 to length(s) do
        if s[i] in ['a'..'z'] then
            s[i] := chr(ord(s[i]) - ord('a') + ord('A'))
  end; (* uppercase *)

procedure eatspaces(var s: string);

var done: boolean;
    i: integer;

  begin
    done := (length(s) = 0);
    while not done do
      begin
        if s[1] = ' ' then
          begin
            i := length(s) - 1;
            s := copy(s,2,i);
            done := length(s) = 0
          end (* if *)
        else
            done := true
      end (* while *)
  end; (* eatspaces *)

procedure isolate_word(var line, s: string);

var i: integer;
    done: boolean;

  begin
    done := false;
    i := 1;
    s := copy(' ',0,0);
    while (i <= length(line)) and not done do
      begin
        if line[i] = ' ' then
            done := true
        else
            s := concat(s,copy(line,i,1));
        i := i + 1;
      end; (* while *)
    line := copy(line,i,length(line)-i+1);
  end; (* isolate_word *)

function get_fn(var line, fn: string): boolean;

var i, l: integer;

  begin
    get_fn := true;
    isolate_word(line, fn);
    l := length(fn);
    if (l < 1) then
        get_fn := false
  end; (* get_fn *)

function getch(var ch: char): boolean;

var s: string;

  begin
    isolate_word(line,s);
    if length(s) <> 1 then
        getch := false
    else
      begin
        ch := s[1];
        get_ch := true
      end (* else *)
  end; (* getch *)

function parse(*: statustype*);

type states = (start, fin, get_filename, get_set_parm, get_parity, get_on_off,
               get_char, get_show_parm, get_help_show, get_help_parm,
               exitstate);

var status: statustype;
    word: vocab;
    state: states;

function get_sym(var word: vocab): statustype;

var i: vocab;
    s: string;
    stat: statustype;
    done: boolean;
    matches: integer;

  begin
    eat_spaces(line);
    if length(line) = 0 then
        getsym := ateol
    else
      begin
        stat := null;
        done := false;
        isolate_word(line,s);
        i := allsym;
        matches := 0;
        repeat
            if (pos(s,vocablist[i]) = 1) and (i in expected) then
              begin
                matches := matches + 1;
                word := i
              end
            else if (s[1] < vocablist[i,1]) then
                done := true;
            if (i = spacesym) then
                done := true
            else
                i := succ(i)
        until (matches > 1) or done;
        if matches > 1 then
            stat := ambiguous
        else if (matches = 0) then
            stat := unrec;
        getsym := stat
      end (* else *)
  end; (* getsym *)

  begin
    state := start;
    parse := null;
    noun := nullsym;
    verb := nullsym;
    adj := nullsym;
    uppercase(line);
    repeat
        case state of
          start:
              begin
                expected := [consym, exitsym, helpsym, quitsym, recsym, sendsym,
                             setsym, showsym];
                status := getsym(verb);
                if status = ateol then
                  begin
                    parse := null;
                    exit(parse)
                  end (* if *)
                else if (status <> unrec) and (status <>  ambiguous) then
                    case verb of
                      consym: state := fin;
                      exitsym, quitsym: state := fin;
                      helpsym: state := get_help_parm;
                      recsym: state := fin;
                      sendsym: state := getfilename;
                      setsym: state := get_set_parm;
                      showsym: state := get_show_parm;
                    end (* case *)
              end; (* case start *)
          fin:
              begin
                expected := [];
                status := getsym(verb);
                if status = ateol then
                  begin
                    parse := null;
                    exit(parse)
                  end (* if status *)
                else
                    status := unconfirmed
              end; (* case fin *)
          getfilename:
            begin
              expected := [];
              if getfn(line,filename) then
                begin
                  status := null;
                  state := fin
                end (* if *)
              else
                  status := fnexpected
            end; (* case get file name *)
          get_set_parm:
              begin
                expected := [paritysym, localsym, ibmsym, escsym,
                             debugsym, filewarnsym];
                status := getsym(noun);
                if status = ateol then
                    status := parm_expected
                else if (status <> unrec) and (status <>  ambiguous) then
                    case noun of
                      paritysym: state := get_parity;
                      localsym: state := get_on_off;
                      ibmsym: state := get_on_off;
                      escsym: state := getchar;
                      debugsym: state := getonoff;
                      filewarnsym: state := getonoff;
                    end (* case *)
            end; (* case get_set_parm *)
          get_parity:
              begin
                expected := [marksym, spacesym, nonesym, evensym, oddsym];
                status := getsym(adj);
                if status = ateol then
                    status := parm_expected
                else if (status <> unrec) and (status <> ambiguous) then
                    state := fin
              end; (* case get_parity  *)
          get_on_off:
              begin
                expected := [onsym, offsym];
                status := getsym(adj);
                if status = ateol then
                    status := parm_expected
                else if (status <> unrec) and (status <> ambiguous) then
                    state := fin
              end; (* get_on_off *)
          get_char:
              if getch(newescchar) then
                 state := fin
              else
                 status := ch_expected;
          get_show_parm:
              begin
                expected := [allsym, paritysym, localsym, ibmsym, escsym,
                             debugsym, filewarnsym];
                status := getsym(noun);
                if status = ateol then
                    status := parm_expected
                else if (status <> unrec) and (status <>  ambiguous) then
                    state := fin
              end; (* case get_show_parm *)
          get_help_show:
              begin
                expected := [paritysym, localsym, ibmsym, escsym,
                           debugsym, filewarnsym];
                status := getsym(adj);
                if (status = at_eol) then
                  begin
                    status := null;
                    state := fin
                  end
                else if (status <> unrec) and (status <>  ambiguous) then
                    state := fin
              end; (* case get_help_show *)
          get_help_parm:
              begin
                expected := [consym, exitsym, helpsym, quitsym, recsym,
                             sendsym, setsym, showsym];
                status := getsym(noun);
                if status = ateol then
                  begin
                    parse := null;
                    exit(parse)
                  end;
                if (status <> unrec) and (status <>  ambiguous) then
                    case noun of
                      consym: state := fin;
                      sendsym: state := fin;
                      recsym: state := fin;
                      setsym: state := get_help_show;
                      showsym: state := fin;
                      helpsym: state := fin;
                      exitsym, quitsym: state := fin;
                    end (* case *)
              end; (* case get_help_show *)
        end (* case *)
    until (status <> null);
    parse := status
  end; (* parse *)

procedure initvocab;

var i: integer;

  begin
    vocablist[allsym] := 'ALL';
    vocablist[consym] := 'CONNECT';
    vocablist[debugsym] := 'DEBUG';
    vocablist[escsym] := 'ESCAPE';
    vocablist[evensym] := 'EVEN';
    vocablist[exitsym] := 'EXIT';
    vocablist[filewarnsym] := 'FILE-WARNING';
    vocablist[helpsym] := 'HELP';
    vocablist[ibmsym] := 'IBM';
    vocablist[localsym] := 'LOCAL-ECHO';
    vocablist[marksym] := 'MARK';
    vocablist[nonesym] := 'NONE';
    vocablist[oddsym] := 'ODD';
    vocablist[offsym] := 'OFF';
    vocablist[onsym] := 'ON';
    vocablist[paritysym] := 'PARITY';
    vocablist[quitsym] := 'QUIT';
    vocablist[recsym] := 'RECEIVE';
    vocablist[sendsym] := 'SEND';
    vocablist[setsym] := 'SET';
    vocablist[showsym] := 'SHOW';
    vocablist[spacesym] := 'SPACE';
  end; (* initvocab *)

  end. (* end of unit *)