(*$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 *)