comment ************************************************* tokenizer.SIM (version 2.9) ============================= renamed from: analyzer.SIM --------------------------- auteur: jean vaucher date : 1997 ( reworked for pretty-printing and integration into other packages ) date : MAI 1995 ( adapte de simanal 8 juillet 1981) This class does the lexical analysis of SIMULA source programs. It is meant to be used as a the Front-end of any program that parses Simula text. USED BY: scope.sim INTERFACE: - Constants for SIMULA symbols, i.e.: if_sy, then_sy, begin_sy... - procedures: - getsy - skip( symb) - chercher( symb) - symbol_is( symb ) - symbol_in( symb_set ) - global variables: - peeksy - usc { unite syntaxique courante: if_sy } - token { text version of USC,ex: "IF" } - NAMES for useful SETS of SYMBOLS: fin_d_enonce fin_comment simple_decl declar decspec - debugging FLAGS: array of 10 BOOLEANS ================================================================= MODIFICATIONS: June 1997 (JV): 2.9 - ensured that all lines had either CR or ' ' at end so that line numbers would correspond to USC. Else the character look-ahead could skip to next 'significant' character which could be several lines ahead when NOT pretty-printing. May 1997 (JV): 2.8 - Modified so that Tokenizer can be used with various Text sources - Files - Text arrays There are 2 virtual procedures that must be provided to adapt the tokenizer to various forms of input: - text procedure inLINE - Boolean procedure ENDFILE Feb 1997 (JV): 2.5 - We found that having sets of just 32 symbols was limiting...so... Added SymSet Class for sets of SYMBOLS of any size ! - Handles "AND THEN" and "OR ELSE" - adapted for PRETTY printing with VIRTUAL procedures called whenever a COMMENT is encountered & to handle special formating of KEYWORDS (Upper-cased by default) Feb 1996 (JV): created version 2.4 - corrected OVERFLOW problem in COMMENT lines - superset of all previous versions - more appropriate initial comments ****************************************************************; class tokenizer; virtual: Procedure inLINE is Text procedure inLINE;; Procedure EndFile is Boolean procedure EndFile;; procedure CreateReader is procedure CreateReader;; Procedure FormatKeyWord is procedure FormatKeyWord(KW) ; text KW;; begin real tokenizer_version = 2.9; integer nligne; character C, CR = '!13!'; Boolean EOF; Boolean PrettyPrinting; ! must be set to TRUE to return COMMENTS AND ; ref(ReaderClass) Reader; class ReaderClass; begin text t, image, t1, com1 ; boolean Overflow, Commentaire ; character TAB = '!9!'; integer ntabs; integer procedure pos; ! position in T taking TABS into account ; pos := T.pos + ntabs; EOF := FALSE; C := ' '; nligne:=0; T :- inLine; FOR nligne := nligne+1 WHILE not Endfile DO BEGIN ntabs := 0; t1 :- if T.length>0 then T.sub(1,1) else notext; Commentaire := (t1 = "%" or t1 = "#"); IF t1 = "%" then resetDebugFlags(t.sub(2,t.length-1)); if trace>2 then begin if sysout.Pos <> 1 then outimage; outint(nligne,5); outtext(" ="); outtext(t); outimage; end; IF Commentaire then begin IF PrettyPrinting then begin Com1 :- "1:" & T.strip ; C := char(1); DETACH; C := CR; DETACH; end else ! ...... rien...... ; End else Begin while t.more do begin C:= t.getchar; if C = TAB then ntabs := ntabs + mod(9-t.pos-ntabs,8); if rank(c) < 32 or rank(c) >127 then c:= ' '; DETACH; end; if PrettyPrinting then c := CR else c := ' '; DETACH ; End; T :- inLINE ; END; c:= ';'; EOF := true; DETACH; outimage; outtext("*** Lecture apres EOF, contact J. Vaucher" " (vaucher@iro.umontreal.ca) "); outimage; C:= ';'; EOF := true; DETACH; error(" Dans ReaderClass: lecture apres EOF"); end *** ReaderClass ***; % ==================================================== % Debugging and feature flags; % Set from comment lines with double %% in cols 1-2. % - 1st digit sets TRACE % - next (up to) 10 characters set FLAG array % '1' means true % '0' means false % else FLAG stay unchanged. % % %%41x0 puts: % 4 -> trace % FLAG(1) <- true % FLAG(2) unchanged % FLAG(3) <- false % FLAG(4..10) unchanged % ==================================================== integer TRACE; Boolean array FLAG(1:10); procedure resetDebugFlags (T); value T; text T; if T =/= notext and then T.getchar = '%' then begin character C; integer i; if T.more then C := T.getchar; if digit(C) then trace := rank(C) - rank('0'); while T.more do begin i := i+1; C := T.getchar; if C = '1' then FLAG(i) := true else if C = '0' then FLAG(i) := false; end; end; procedure traceMsg(Level,Msg); integer level; text Msg; if TRACE >= level then outline(Msg); ! ------------------------------------------------ ; integer comment_sy, ident_sy, begin_sy, end_sy, decl_sy, spec_sy, text_sy, class_sy, external_sy, is_sy, inspect_sy, when_sy, do_sy, otherwise_sy, if_sy, then_sy, else_sy, virtual_sy, array_sy, label_sy, qua_sy, procedure_sy, ref_sy, switch_sy, while_sy, for_sy, assign_sy, pv_sy, deux_points, comma, period, leftPar, rightPar, other_sy, nl_sy, fdf_sy, double_start, or_sy, and_sy, this_new_sy, number_sy, minus_sy, mul_sy; ! Classes de symboles ; Ref( SymSet ) fin_d_enonce, fin_comment, simple_decl, declar, virtual_spec, decspec, nonWords ; ref(SymSet) ExpSymbols, When_Do, Inspect_set, Param_set, pv_comma; procedure init_sy; begin integer i, n; integer procedure NC; comment next_code ; begin nc:= n; n := n+1; end; n := 1; array_sy :=nc; assign_sy :=nc; begin_sy :=nc; class_sy :=nc; deux_points:= nc; decl_sy :=nc; ! decl_sy == bool, int, real, char, short, long ; do_sy :=nc; end_sy :=nc; else_sy :=nc; external_sy:=nc; fdf_sy :=nc; ident_sy :=nc; inspect_sy:=nc; label_sy :=nc; other_sy :=nc; procedure_sy:=nc; pv_sy :=nc; qua_sy :=nc; ref_sy :=nc; switch_sy :=nc; spec_sy :=nc; ! spec_sy == name, value, hidden, protected ; then_sy :=nc; virtual_sy:=nc; comma :=nc; leftpar :=nc; rightpar :=nc; period :=nc; is_sy :=nc; otherwise_sy:=nc; when_sy :=nc; comment_sy:=nc; if_sy :=nc; while_sy := nc; for_sy := nc; nl_sy := nc; double_Start := nc; and_sy := nc; or_sy := nc; this_new_sy := nc ; number_sy := nc ; mul_sy := nc ; minus_sy := nc ; fin_d_enonce :- new SymSet(N). add(fdf_sy). add(pv_sy). add(end_sy); fin_comment :- fin_d_enonce.copy .add(else_sy) .add(when_sy) .add(otherwise_sy); simple_decl :- new SymSet(N) ! ===> types possibles pour procedure ; .add(decl_sy) .add(ref_sy); declar :- simple_decl.copy .add(array_sy) .add(switch_sy) .add(procedure_sy) .add(class_sy) .add(external_sy); virtual_spec :- simple_decl.copy .add(label_sy) .add(switch_sy) .add(procedure_sy); decspec :- virtual_spec.copy .add(spec_sy); ExpSymbols :- new SymSet(50).add(ident_sy) .add(number_sy) .add(other_sy) .add(mul_sy) .add(minus_sy) .add(this_new_sy) .add(is_sy) .add(qua_sy) .add(leftPar) .add(if_sy) ; When_do :- new SymSet(50).add(when_sy) .add(do_sy); Inspect_set :- fin_d_enonce.copy .add(when_sy) .add(otherwise_sy); Param_set:- fin_d_enonce.copy .add(rightPar); pv_comma :- new SymSet(50) .add(pv_sy) .add(comma); for i := 0 step 1 until maxrank do charType(i) := other_sy; charType( rank(';') ) := pv_sy; charType( rank(':') ) := deux_points; % charType( 1 ) := comment_sy; charType( rank('!') ) := comment_sy; charType( rank(',') ) := comma; charType( rank('.') ) := period; charType( rank('(') ) := leftPar; charType( rank(')') ) := rightPar; charType( rank('-') ) := minus_sy; charType( rank(':') ) := Double_start; charType( rank('*') ) := Double_start; charType( rank('/') ) := Double_start; charType( rank('>') ) := Double_start; charType( rank('<') ) := Double_start; charType( rank('=') ) := Double_start; end *** init_sy *** ; procedure init_table; begin table :- new table_class(107); inspect table do begin add("array", array_sy); add("begin", begin_sy); add("boolean", decl_sy); add("character",decl_sy); add("class", class_sy); add("comment", comment_sy); add("end", end_sy); add("external", external_sy); add("integer", decl_sy); add("is", is_sy); add("label", decl_sy); add("long", decl_sy); add("name", spec_sy); add("procedure",procedure_sy); add("real", decl_sy); add("ref", ref_sy); add("short", decl_sy); add("switch", switch_sy); add("text", decl_sy); add("value", spec_sy); add("virtual", virtual_sy); add("if", if_sy); add("then", then_sy); add("else", else_sy); add("inspect", inspect_sy); add("when", when_sy); add("do", do_sy); add("otherwise",otherwise_sy); add("call", other_sy); add("detach", other_sy); add("false", other_sy); add("go", other_sy); add("to", other_sy); add("goto", other_sy); add("hidden", spec_sy); add("for", for_sy ); add("in", other_sy); add("inner", other_sy); add("new", this_new_sy); add("none", other_sy); add("notext", other_sy); add("protected", spec_sy); add("qua", qua_sy); ! Period ??? <<=== to handle 'X qua Y.Z' like 'X.Y.Z' ; add("step", other_sy); add("this", this_new_sy); add("true", other_sy); add("until", other_sy); add("while", while_sy); add("activate",other_sy); add("after", other_sy); add("at", other_sy); add("before", other_sy); add("delay", other_sy); add("prior", other_sy); add("reactivate",other_sy); add("and", and_sy); add("or", or_sy); add("eq", other_sy); add("eqv", other_sy); add("ge", other_sy); add("gt", other_sy); add("imp", other_sy); add("le", other_sy); add("lt", other_sy); add("ne", other_sy); add("not", other_sy); end; end *** init_table ***; ! ********************************************************************; ! ***************** hashtable of key words **************************; ! ********************************************************************; ref(TABLE_CLASS) table; class kword(t,code); text t; integer code; begin ref(kword) suc; end; class TABLE_CLASS(size); integer size; begin ref(kword) array index (1:size); integer i; integer procedure hash(t); text t; begin integer N, K; K := abs( minint // 16); t.Setpos(1); while t.More do begin N := 11*N + Rank(t.Getchar); IF N > K THEN N := rem( N, K); end; hash := randint(1, size, N); end of HASH; procedure add (t,code); value t; text t; integer code; begin ref(kword) p,pp,k; integer i; i:= hash(t); k:- new kword(t,code); p:- index(i); if t<= p.t then index(i) :- k else begin while t > p.t do begin pp:-p; p:-p.suc end; pp.suc:-k; end; k.suc:-p; end ** add **; integer procedure lookup (t); text t; begin comment this procedure is expanded in-line where needed ; end ** lookup **; for i:= 1 step 1 until size do index(i) :- new kword(copy("~"),0); end ** table_class **; ! ********************************************************************; ! **** Public procedures: GETSY & GETSY2 **************************; ! ********************************************************************; % GETSY: gets the next significant symbol. After GetSy, the result % is placed in GLOBAL variables: % % USC: contains a symbol code such as "begin_sy" and % TOKEN: returns the Text corresponding to the symbol % % [Note: USC stands for Unite Syntaxique Courante, current syntactic unit] % For Pretty printing applications where comments and user line breaks are % significant, one should use GETSY2 instead % GETSY2: also returns NewLine and Comments as special syntactic units Procedure GetSy; begin GetSy2; while usc = nl_sy or usc = comment_sy do GetSy2; ; end; Procedure GetSy2; if SymbCount>0 then begin DEQUEUE; if trace > 2 then outLine(" {{" & intAsText(usc) & ":" & Token & "}} "); end else GetSymb; integer USC, usc2; text Sy, Sy2; Boolean Peeked; Text reference, tmpRef ; integer array charType(0:maxrank); ref(Symbol) SQFirst, SQLast; integer SymbCount; Class Symbol(usc,T); value T; integer usc; text T; begin ref(Symbol) suc; end; procedure EnQueue(E); ref(Symbol) E; begin SymbCount := SymbCount+1; if SQFirst == none then SQFirst :- SQLast :- E else begin SQLast.suc :- E; SQLast :- SQLast.suc ; end; end; procedure DeQueue; begin SymbCount := SymbCount-1; usc := SQFirst.usc; restoreSy(Sy, SQFirst.T); if SQFirst == SQLast then SQFirst :- SQLast :- none else SQFirst :- SQFirst.suc; end; integer procedure PeekSy; if SymbCount>1 then PeekSy:= SQFirst.usc else begin integer U; text T; U := usc; T :- Sy; Sy :- Sy2; getSy; PeekSy := usc; EnQueue(new Symbol(usc, Token)); usc := U; Sy :- T; traceMsg(3,"Restore to " & Token & ":" & intAsText(usc)); end; Procedure restoreSy(Sy,T); name Sy; Text Sy,T; begin if Sy.length < T.length then Sy :- blanks(T.length); Sy.sub(1,T.length) := T; Sy.setpos(T.length+1); end; PROCEDURE copyChar; IF not EOF then BEGIN IF NOT sy.More then BEGIN TEXT T; T :- sy & Blanks(0.5 * sy.Length+1); T.SetPos(sy.Pos); Sy :- T; END; sy.PutChar(c); Call(Reader) END; TEXT PROCEDURE Token; Token :- sy.Sub(1,sy.Pos-1); procedure ChercherC (Cc); character Cc; while C<>Cc and not EOF do call (Reader); procedure CopyTo (Cc); character Cc; while not EOF and C<>Cc do copyChar; integer array Ctype(0:127); procedure Init_GetSy; BEGIN integer i; character cc; sy:- Blanks(40); sy2 :- Blanks(40); tmpRef :- blanks(32); for i := 0 step 1 until 127 do Ctype(i) := 10; for i := rank('a') step 1 until rank('z'), rank('A') step 1 until rank('Z') do Ctype(i) := 1; for i := rank('0') step 1 until rank('9') do Ctype(i) := 2; Ctype(rank('.')) := 3; Ctype(rank(''')) := 4; Ctype(rank('"')) := 5; Ctype( 1 ) := 6; Ctype(rank('!')) := 7; Ctype(rank(CR)) := 8; for cc := ':','*','/','>','<','=' do Ctype(rank(Cc)) := 9; END; PROCEDURE GetSymb; begin SWITCH SW := E_Letter, E_digit, E_period, E_4, E_quote, E_6, E_comment, E_CR, E_9, E_10; text t; ref(kword) p; usc := other_sy; sy.SetPos(1); while c = ' ' do call (Reader); if not EOF then GOTO SW( Ctype(rank(C)) ); E_FDF: usc:= fdf_sy ; GOTO exit; E_CR: ! c = CR ; usc := nl_sy; call(READER); GOTO exit; E_Letter: begin integer procedure look_up_kw (W); value W; text W; begin ref(kword) p; lowcase(W); p :- table.index(table.hash(W)); while W > p.t do p:-p.suc; if W=p.t then look_up_kw := p.code else look_up_kw := ident_sy end; Text TempSy; copyChar; while letter(c) or digit(c) or c='_' do begin copyChar end; usc := look_up_kw(Token); if usc <> ident_sy then begin FormatKeyWord(Token) ; if usc = OR_SY then begin TempSy :- Sy; Sy :- Sy2; GetSy; if usc = else_sy then restoreSy(TempSy,"Or else") else enQueue(new Symbol(usc,Token)); Sy:- TempSy; usc := other_sy; end else if usc = AND_SY then begin TempSy :- Sy; Sy :- Sy2; GetSy; if usc = then_sy then restoreSy(TempSy, "And then") else enQueue(new Symbol(usc,Token)); Sy:- TempSy; usc := other_sy; end else if usc = comment_sy then goto E_comment else if usc=ref_sy then begin TmpRef := notext; while c <> '(' and not EOF do copyChar; copyChar; while c <> ')' and not EOF do begin if reference.more then reference.putchar(C); copyChar; end; reference :- lowcase(TmpRef.strip); copyChar; end; end; end; GOTO exit; E_digit: usc := number_sy; while digit(c) or c='.' or c = '&' or c='_' DO copyChar; if C = 'R' or C = 'r' then begin copyChar; while hexdigit(C) do copyChar; end; GOTO exit; E_period: copyChar; if digit(c) then while digit(c) or c = '&' or c='_' DO copyChar else usc := period; GOTO exit; E_4: ! c = ''' ; copyChar ; copyChar ; while not (c = ''' or EOF) do copyChar; copyChar; GOTO exit; E_quote: ! c = '"' ; while c = '"' do begin copyChar ; while not (c = '"' or EOF) do copyChar; copyChar; end; GOTO exit; E_6: ! c = '!1!' ... code for a "%" in col.1 ; restoreSy(Sy, Reader.Com1); call(READER); usc := comment_sy; GOTO exit; E_comment: ! c = '!' or "comment_sy" ; begin Text TPos; integer N; usc := comment_sy; N := reader.pos - Sy.pos; if C=CR then N:= N+1; TPos :- intAsText(N) & ":"; while not(C=';' or C=CR) do copyChar; if C = ';' then begin copyChar; restoreSy(Sy, TPOS & Token); end else begin while C <> ';' do begin EnQueue(new Symbol(comment_sy, TPOS & Token) ); call(READER); TPOS :- copy("1:"); Sy.setpos(1); while not(C=';' or C=CR) do copyChar; end; copyChar; EnQueue(new Symbol(comment_sy, TPOS & Token) ); Dequeue; end; end --- commentaire --- ; GOTO exit; % ---------------------------------------------------------------- % Operateurs multi-caracteres: :=, :-, <>, >=, <=, =/=, ==, % **, // % ---------------------------------------------------------------- E_9: begin Boolean procedure Check(Cc); character Cc; if C = Cc then begin copyChar; Check := true; end; usc := other_sy; if c=':' then begin copyChar ; if c = '-' or c = '=' then begin copyChar; usc := assign_sy; end else usc := deux_points; end else if check('=') then begin if check('/') then check('=') else check('=') end else if check('>') then check('=') else if check('<') then begin if not check('=') then check('>') else check('=') end else begin usc := mul_sy; if check('*') then check('*') else if check('/') then check('/') end; end; GOTO exit; E_10: ! Autre Operateur ; usc := charType(rank(c)); copyChar; EXIT: if trace > 2 then outText(" <<" & intAsText(usc) & ":" & Token & ">>"); END --- GETSYMB ----; % ------------------------------- % Procedures d'interface % ------------------------------- procedure TreatComment(T, nPos); text T; integer nPos; begin outimage; outtext(">>>>> "); outtext(T); outimage; end; Procedure FormatKeyWord(KW) ; text KW; if KW =/= Notext then begin LowCase(KW); upCase(KW.sub(1,1)); end; Text procedure GetEndComment; begin procedure EndStuff; begin Sy.setpos(1); while not letter(C) and C<>';' do copyChar; T :- T & Token; GetSy; end; Text T; while not symbol_in(fin_comment) do begin T :- T & Token; EndStuff; end; GetEndComment :- T; end; % ------------------------------- % UTILITAIRES % ------------------------------- integer margin, MARGIN1 = 8; procedure OutLine(T); Text T; begin outtext(T); outimage end; Boolean procedure hexDigit(C); character C; HexDigit := digit(C) or else (C >= 'a' and C <= 'f') or else (C >= 'A' and C <= 'F'); procedure Chercher (s); ref(SymSet) s; begin while usc<>fdf_sy and then not symbol_in (S) do getsy; end ** chercher **; procedure Chercher1 (s); integer s; begin while usc<>fdf_sy and then not symbol_is (S) do getsy; end ** chercher **; Boolean procedure symbol_is(S); integer S; symbol_is := usc = S; Boolean procedure symbol_in(S); ref(Symset) S; symbol_in := S.contains(USC) ; Boolean procedure Contains (set,elem); integer elem; ref(SymSet) set; Contains:= Set.contains(Elem) ; procedure Skip(Sy); integer Sy; if usc = Sy then getSy; text procedure intAsText(N); integer N; begin text T; intAsText :- T :- blanks( if N <10 then 1 else if N < 100 then 2 else if N < 1000 then 3 else if N < 10000 then 4 else if N < 1000000 then 6 else 10); T.putint(N); end; class SymSet(N); integer N; begin integer Lim = 31; integer array S(0:N//Lim); Boolean procedure contains(X); integer X; if X <= N then begin integer a,b; a := X//Lim; b := 2**rem(X,Lim); contains := rem( S(a) // b, 2) = 1; end; procedure dump; begin integer i; for i := 0 step 1 until N-1 do outchar(if Contains(i) then '1' else '0'); end; ref(SymSet) procedure Copy; begin ref(SymSet) SS; integer i; copy :- SS :- new SymSet(N); for i := 0 step 1 until N//Lim do SS.S(i) := S(i); end; ref(SymSet) procedure add(X); integer X; begin if X >= 0 and X<= N then begin integer a,b; a := X//Lim; b := 2**rem(X,Lim); if rem( S(a) // b, 2) <> 1 then S(a) := S(a) + b; end; add :- this Symset; end; ref(SymSet) procedure sub(X); integer X; begin if X >= 0 and X<= N then begin integer a,b; a := X//Lim; b := 2**rem(X,Lim); if rem( S(a) // b, 2) = 1 then S(a) := S(a) - b; end; sub :- this Symset; end; end ----- SymSet ----- ; % >>>>>>>>>>>>>>>>>>>>>>>>>> % INITIALISATIONS % <<<<<<<<<<<<<<<<<<<<<<<<<< init_sy; init_table; Init_GetSy ; end -- analyzer ---; tokenizer CLASS FileTokenizer( Sysin ); ref( Infile) sysin; begin Text procedure inLine; inspect sysin do begin text T; Boolean overflow; overflow := inrecord; if overflow then begin while overflow do begin T :- T & image; overflow := inrecord; end; inLine :- image :- T & image.sub(1,image.pos-1); end else inLine :- image.sub(1, pos - 1); end --- inline ---; Boolean procedure EndFile; EndFile := sysin.endfile; procedure Reset(FileIn); ref(Infile) FileIn; begin C := ' '; SymbCount := 0;; SQFirst :- SQLast :- none; Reader :- new ReaderClass; end; if Sysin =/= none then Reset(Sysin); end ----- FileTokenizer ------------ ;