ESyntax10.Scn.Fnt Syntax10i.Scn.Fnt0+IStampElemsAlloc3 Jun 97Syntax10b.Scn.FntV`8FoldElemsNew8D8"8(8y8:88+8a8a88;8H8XParcElemsAlloc  сg%2COMPILER PF (** Christian Mayrhofer, Friedrich Traunmueller  *) (*------------------- imports and global declarations -------------------------*) IMPORT Texts; TYPE Name = ARRAY 32 OF CHAR; VAR out*: Texts.Text; (* text have to initiated with output text before parseing starts *) time*: BOOLEAN; (* have to initated before parsing starts, TRUE for time measurement, FALSE for block counting *) offset: LONGINT; w, scope: Texts.Writer; counter: INTEGER; importList: BOOLEAN; importPos, inProcPos, inBodyPos: LONGINT; moduleName: Name; proc, varDecl, dummy : BOOLEAN; PROCEDURE InsertNewScope (counter: INTEGER; beg, end: LONGINT); BEGIN Texts.WriteString(scope, " PFMod.InitScope("); Texts.WriteInt(scope, counter, 0); Texts.Write(scope, ","); Texts.WriteInt(scope, beg, 0); Texts.Write(scope, ","); Texts.WriteInt(scope, end, 0); Texts.WriteString(scope, ");"); Texts.WriteLn(scope); END InsertNewScope;  PROCEDURE InsertNewNameScope (counter: INTEGER; beg, end: LONGINT); BEGIN Texts.WriteString(scope, " PFMod.SetNameScope("); Texts.WriteInt(scope, counter, 0); Texts.Write(scope, ","); Texts.WriteInt(scope, beg, 0); Texts.Write(scope, ","); Texts.WriteInt(scope, end, 0); Texts.WriteString(scope, ");"); Texts.WriteLn(scope); END InsertNewNameScope;  PROCEDURE InsertBuffer (pos: LONGINT); VAR len: LONGINT; BEGIN len := w.buf.len; Texts.Insert(out, pos + offset, w.buf); INC(offset, len) END InsertBuffer;  PROCEDURE InsertProcess (counter: INTEGER; pos: LONGINT); BEGIN Texts.WriteString(w, " PFMod.Process("); Texts.WriteInt(w, counter, 0); Texts.WriteString(w, ");"); InsertBuffer(pos) END InsertProcess;  PROCEDURE InsertEndProcess (pos: LONGINT); BEGIN Texts.WriteString(w, " ;PFMod.EndProcess();"); InsertBuffer(pos) END InsertEndProcess;  PROCEDURE InsertModRequest (allocateProc, name: ARRAY OF CHAR; counters: INTEGER; pos: LONGINT); BEGIN Texts.WriteString(w, " PFMod := PFBasic. " ); Texts.WriteString(w, allocateProc); Texts.WriteString(w, '("'); Texts.WriteString(w, name); Texts.WriteString(w, '", ' ); Texts.WriteInt(w, counters, 0); Texts.WriteString(w, ");"); InsertBuffer(pos); END InsertModRequest;  PROCEDURE InsertStr (string: ARRAY OF CHAR; pos: LONGINT); BEGIN Texts.WriteString(w, string); InsertBuffer(pos) END InsertStr;  (*--------------------------- scanner specification -------------------------------*) CHARACTERS letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz". digit = "0123456789". hexDigit = digit + "ABCDEF". eol = CHR(13). tab = CHR(9). elem = CHR(28). (* text element *) noQuote1 = ANY - '"' - eol. noQuote2 = ANY - "'" - eol. TOKENS ident = letter {letter | digit}. string = '"' {noQuote1} '"' | "'" {noQuote2} "'". character = digit {hexDigit} "X". (* number = integer | real. *) integer = digit {digit} | digit {hexDigit} "H" | digit {digit} CONTEXT("..") | digit {hexDigit} "H" CONTEXT("..") . real = digit {digit} "." {digit} [ ("E" | "D") ["+" | "-"] digit {digit} ]. IGNORE CHR(1)+CHR(2)+CHR(3)+CHR(4)+CHR(5)+CHR(6)+CHR(7)+CHR(8)+CHR(9)+ CHR(10)+CHR(11)+CHR(12)+CHR(13)+CHR(14)+CHR(15)+CHR(16)+CHR(17)+CHR(18)+CHR(19)+ CHR(20)+CHR(21)+CHR(22)+CHR(23)+CHR(24)+CHR(25)+CHR(26)+CHR(27)+CHR(28)+CHR(29)+ CHR(30)+CHR(31) COMMENTS FROM "(*" TO "*)" NESTED (*-----------------------------parser specification --------------------------------*) PRODUCTIONS PF (. VAR moduleBody: BOOLEAN; nbeg, nend, mbeg, mend: LONGINT; .) = (. counter := 0; moduleBody := FALSE; importList := FALSE; proc := FALSE; varDecl := FALSE; inProcPos := 0; Texts.OpenWriter(w); Texts.OpenWriter(scope); offset := 0; nbeg := 0; nend := 0; .) "MODULE" (. mbeg := PFS.pos; .) Ident ";" (. importPos := PFS.pos; .) [ ImportList ] DeclSeq [ "BEGIN" (. moduleBody := TRUE; inBodyPos := PFS.pos + PFS.len; .) StatementSeq ] "END" (. IF proc THEN mend := PFS.pos + PFS.len; IF ~moduleBody THEN InsertStr(" BEGIN ", PFS.pos); inBodyPos := PFS.pos; END ; IF time THEN InsertModRequest("NewModuleTime", moduleName, counter + 1, inBodyPos); ELSE InsertModRequest("NewModule", moduleName, counter + 1, inBodyPos); END; InsertNewScope(counter, mbeg, mend); IF time THEN InsertNewNameScope(counter, nbeg, nend); END; offset := offset + scope.buf.len; Texts.Insert(out, inBodyPos + offset - scope.buf.len, scope.buf); InsertProcess(counter, inBodyPos); IF time THEN InsertEndProcess(PFS.pos) END; offset := 0; IF importList THEN InsertStr(", PFBasic", importPos); ELSE InsertStr("; IMPORT PFBasic", importPos); END; IF ~varDecl THEN InsertStr(" VAR ", inProcPos); END; IF time THEN InsertStr("PFMod: PFBasic.ModuleTime; ", inProcPos) ELSE InsertStr("PFMod: PFBasic.Module; ", inProcPos) END END; .) ident ".". ImportList = "IMPORT" (. importList := TRUE; .) ident [":=" ident] {"," ident [":=" ident]} ";" (. importPos := PFS.pos .) . DeclSeq (. VAR c: INTEGER; procBeg, beg, end, pos: LONGINT; body: BOOLEAN; .) = { "CONST" {ConstDecl ";"} | "TYPE" {TypeDecl ";"} | "VAR" (. vDecl := TRUE; .) {VarDecl ";"} } { "PROCEDURE" (. IF ~proc THEN proc := TRUE; inProcPos := PFS.pos + offset END; procBeg := PFS.pos .) ( ProcDecl ";" (. IF body THEN InsertNewScope(c, procBeg, PFS.pos + PFS.len); IF time THEN InsertNewNameScope(c, beg, end); InsertEndProcess(pos) END END; .) | ForwardDecl ";" ) }. ConstDecl = IdentDef "=" ConstExpr. TypeDecl = IdentDef "=" Type. VarDecl = IdentList ":" Type. Code = {character} {"," character}. ProcDecl (. VAR beg1: LONGINT; codeProc: BOOLEAN; .) = (. body := FALSE; beg1 := -1; .) [ Receiver ] ProcIdentDef (. IF beg1 >= 0 THEN beg := beg1 END .) [FormalPars] ";" DeclSeq [ "BEGIN" (. body := TRUE; c := counter; (* IF ~time THEN beg := PFS.pos + PFS.len END; *) InsertProcess(counter, PFS.pos + PFS.len); INC(counter); .) StatementSeq ] (("END" (.IF ~body THEN body := TRUE; c := counter; InsertStr(" BEGIN ", PFS.pos); InsertProcess(counter, PFS.pos); INC(counter); END; pos := PFS.pos .) ident) | ( (. ASSERT(codeProc) .) {Code} ) ) (* "END" (.IF ~body THEN body := TRUE; c := counter; InsertStr(" BEGIN ", PFS.pos); InsertProcess(counter, PFS.pos); INC(counter); END; pos := PFS.pos .) ident *) . ForwardDecl (. VAR dummy: LONGINT; .) = "^" [Receiver < dummy >] IdentDef [FormalPars]. FormalPars = "(" [FPSection {";" FPSection}] ")" [":" Qualident]. FPSection = ["VAR"] ident {"," ident} ":" Type. Receiver = "(" (. beg := PFS.pos .) ["VAR"] ident ":" ident ")". Type = Qualident | "ARRAY" [ConstExpr {"," ConstExpr}] "OF" Type | "RECORD" ["(" Qualident ")"] [IdentList ":" Type] {";" [IdentList ":" Type]} "END" | "POINTER" "TO" Type | "PROCEDURE" [FormalPars]. StatementSeq = Statement {";" Statement}. Statement (. VAR beg, beg1, pos1, blockBeg: LONGINT; blockCounter, counter1: INTEGER; block, brunch: BOOLEAN; .) = [ (* original part of Oberon - Grammar: Designator ( ":=" Expr | [ "(" [ExprList] ")"] ) *) Designator [":=" Expr] | "IF" (. IF ~time THEN beg := PFS.pos END; .) Expr "THEN" (. IF ~time THEN counter1 := counter; InsertProcess(counter, PFS.pos + PFS.len); INC(counter) END; .) StatementSeq { "ELSIF" (. IF ~time THEN InsertNewScope(counter1, beg, PFS.pos); beg := PFS.pos END .) Expr "THEN" (. IF ~time THEN counter1 := counter; InsertProcess(counter, PFS.pos + PFS.len); INC(counter); END .) StatementSeq } [ "ELSE" (. IF ~time THEN InsertNewScope(counter1, beg, PFS.pos); beg := PFS.pos; counter1 := counter; InsertProcess(counter, PFS.pos + PFS.len); INC(counter); END .) StatementSeq ] "END" (. IF ~time THEN InsertNewScope(counter1, beg, PFS.pos + PFS.len); END .) | "CASE" (. IF ~time THEN beg1 := PFS.pos END; .) Expr "OF" (. IF ~time THEN InsertProcess(counter, beg1); counter1 := counter; INC(counter); blockBeg := PFS.pos + PFS.len END .) Case { "|" (. IF ~time & block THEN InsertNewScope(blockCounter, blockBeg, PFS.pos); blockBeg := PFS.pos END; .) Case } [ "ELSE" (. IF ~time & block THEN InsertNewScope(blockCounter, blockBeg, PFS.pos); blockBeg := PFS.pos; blockCounter := counter; InsertProcess(counter, PFS.pos + PFS.len); INC(counter) END .) StatementSeq ] "END" (. IF ~time THEN IF block THEN InsertNewScope(blockCounter, blockBeg, PFS.pos) END; InsertNewScope(counter1, beg1, PFS.pos + PFS.len) END; .) | "WHILE" (. IF ~time THEN beg := PFS.pos END; .) Expr "DO" (. IF ~time THEN counter1 := counter; InsertProcess(counter, PFS.pos + PFS.len); INC(counter) END; .) StatementSeq "END" (. IF ~time THEN InsertNewScope(counter1, beg, PFS.pos + PFS.len) END; .) | "REPEAT" (. IF ~time THEN beg := PFS.pos; counter1 := counter; InsertProcess(counter, PFS.pos + PFS.len); INC(counter) END; .) StatementSeq "UNTIL" (. IF ~time THEN InsertNewScope(counter1, beg, PFS.pos + PFS.len) END; .) Expr | "FOR" (. IF ~time THEN beg := PFS.pos END; .) ident ":=" Expr "TO" Expr ["BY" ConstExpr] "DO" (. IF ~time THEN counter1 := counter; InsertProcess(counter, PFS.pos + PFS.len); INC(counter); END; .) StatementSeq "END" (. IF ~time THEN InsertNewScope(counter1, beg, PFS.pos + PFS.len) END; .) | "LOOP" (. IF ~time THEN beg := PFS.pos; counter1 := counter; InsertProcess(counter, PFS.pos + PFS.len); INC(counter) END; .) StatementSeq "END" (. IF ~time THEN InsertNewScope(counter1, beg, PFS.pos + PFS.len) END; .) | "WITH" (. IF ~time THEN beg1 := PFS.pos END;.) Guard "DO" (. IF ~time THEN counter1 := counter; InsertProcess(counter, beg1); INC(counter); blockBeg := PFS.pos + PFS.len; blockCounter := counter; InsertProcess(counter, PFS.pos + PFS.len); INC(counter) END; .) StatementSeq { "|" (. IF ~time THEN InsertNewScope(blockCounter, blockBeg, PFS.pos); blockBeg := PFS.pos END; .) Guard "DO" (. IF ~time THEN blockCounter := counter; InsertProcess(blockCounter, PFS.pos + PFS.len); INC(counter) END; .) StatementSeq } [ "ELSE" (. IF ~time THEN InsertNewScope(blockCounter, blockBeg, PFS.pos); blockBeg := PFS.pos; blockCounter := counter; InsertProcess(blockCounter, PFS.pos + PFS.len); INC(counter) END; .) StatementSeq ] "END" (. IF ~time THEN InsertNewScope(blockCounter, blockBeg, PFS.pos + PFS.len); InsertNewScope(counter1, beg1, PFS.pos + PFS.len) END; .) | "EXIT" | "RETURN" (. IF time THEN InsertEndProcess(PFS.pos) END;.) [Expr] ]. Case = (. block := FALSE; .) [CaseLabels {"," CaseLabels} ":" (. IF ~time THEN block := TRUE; blockCounter := counter; InsertProcess(blockCounter, PFS.pos + PFS.len); INC(counter); END; .) StatementSeq ]. CaseLabels = ConstExpr [".." ConstExpr]. Guard = Qualident ":" Qualident. ConstExpr = Expr. Expr = SimpleExpr [Relation SimpleExpr]. SimpleExpr = ["+" | "-"] Term {AddOp Term}. Term = Factor {MulOp Factor}. Factor = (* original part of Oberon - Grammar: Designator [ "(" [ExprList] ")" ] *) Designator | integer | real |character |string | "NIL" | Set | "(" Expr ")" | "~" Factor. Set = "{" [Element {"," Element}] "}". Element = Expr [".." Expr]. Relation = "=" | "#" | "<" | "<=" | ">" | ">=" | "IN" | "IS". AddOp = "+" | "-" | "OR". MulOp = "*" | "/" | "DIV" | "MOD" | "&". Designator = ident {"." ident | "[" ExprList "]" | "^" (* original part of Oberon - Grammar: "(" Qualident ")" *) | "(" [ExprList] ")" }. ExprList = Expr {"," Expr}. IdentList = IdentDef {"," IdentDef}. Qualident = ident [ "." ident]. IdentDef = ident ["*" | "-"]. ProcIdentDef = [ "*"] (. (* star-marked procedures (for assignment to procedure variable) *) .) (. codeProc := FALSE .) ["-" (. codeProc := TRUE .) ] ident (. beg := PFS.pos; end := PFS.pos + PFS.len .) [ "*" | "-" ]. Ident = ident (. beg := PFS.pos; end := PFS.pos + PFS.len; PFS.GetName(PFS.pos, PFS.len, name); .) . END PF.