ORIGIN 'astlevel'; INCLUDE '~beta/basiclib/file'; LIB_ITEM 'mpsastlevel'; (* * COPYRIGHT * Copyright (C) Mjolner Informatics, 1986-93 * All rights reserved. *) -- fragmentgrouplib: Attributes -- propertyParser: (* for parsing a property specification *) (* Recursive-descend parser for the grammar: * * <group> ::= <propertyList>; * <propertyList> ::= <property> {';' property}* ; * <property> ::| <predefined property> * | <auxilary property> ; * <predefined property> ::| <origin property> | <include property> * | <body property> | <mdbody property> ; * <origin property> ::= 'ORIGIN' STRING ; * <include property> ::= 'INCLUDE' STRING {STRING}* ; * <body property> ::= 'BODY' STRING {STRING}* ; * <mdbody property> ::= 'MDBODY' NAME STRING {NAME STRING}* ; * <auxilary property>::= <propertyName> {NAME | STRING | CONST}* | EMPTY ; * * Lexical tokens: --(-)* [[ ]] ; : NAME STRING CONST EOF * *) (# parseErrors:< (* exception called if parse-errors *) astInterfaceException; doubleFormDeclaration:< (* exception called if two fragmentForms with the same name *) astInterfaceException; input: ^stream; error: ^stream; ok: @boolean; dash: (# exit - 1 #); beginGroup: (# exit - 2 #); endGroup: (# exit - 3 #); name: (# exit - 4 #); string: (# exit - 5 #); const: (# exit - 6 #); EOF: (# exit - 7 #); origin: (# exit - 8 #); include: (# exit - 9 #); body: (# exit - 10 #); mdbody: (# exit - 11 #); semiColon: (# exit ';' #); colon: (# exit ':' #); EOSchar: @char; inputPos,lastOKPos: @integer; firstComment: @boolean; fgComment: @Text; get: @ (# printError: @ (# do 'Read ascii NULL character during property parsing.\n' -> screen.putText; 'fullname is ' -> screen.putText; fullname->screen.putline; 'inputpos is ' -> screen.putText; inputpos->screen.putint; screen.newLine; #); do (if input.eos then EOF->nextCh else inputPos+1->inputPos;input.get->nextCh; (if nextCh=0 then printError; else CommentSieve[nextCh]->nextCh; if) if) exit nextCh #); dirWriteable: @ (# f: @file enter f.name exit f.entry.writeable (# error:: (# do true->continue; (errorNumbers.otherFileError,msg[])->catcher #) #) #); markError: (# whatToBeExpected: @text; errorPos,inx,noOfTerminals: @integer; ch: @char; errorReport: (# N: @integer; beforeText: @text; get: @input.get; eos: @input.eos; ch: @char; print,oldPrint: @boolean; startLineNo,lineNo: @integer; pos,first,beforePos: @integer; lst: ^stream; constructLegals: (# symb: ^parseSymbolDescriptor; j: @integer; t: ^text do &parseSymbolDescriptor[]->symb[]; noOfTerminals->symb.terminals.new; 0->whatToBeExpected.pos; (for i: NoOfTerminals repeat whatToBeExpected.getAtom->t[]; t[]->symb.terminals[i][]; for) exit symb[] #); enter lst[] do 1->lineNo; THIS(fragmentGroup)[]->theErrorReporter.frag[]; lst[]->theErrorReporter.errorStream[]; theErrorReporter.beforeFirstError; 1->N; Loop: (if (N <= 1) then print->oldPrint; ((errorPos-100) <= pos)->print; (if print then (if oldPrint then (if (beforeText.length > 100) then startLineNo+1->startLineNo; test: ascii.newLine ->beforeText.findAll (# do inx+beforePos->beforePos; (1,inx)->beforeText.delete; leave test #); if) else beforeText.clear; pos->beforePos; lineNo->startLineNo; if) if); lineNo+1->lineNo; pos->first; readLine: (# do pos+1->pos; (if eos then leave readline if); get->ch; (if print then ch->beforeText.put if); (if ch = ascii.newline then leave readLine if); restart readLine; #); (if print then mark: (if (errorPos <= pos) then (errorPos,startLineNo,beforeText,errorPos-beforePos, constructLegals)->theErrorReporter.forEachError; N+1->N; if); if); restart Loop if); theErrorReporter.afterLastError; #); lstFile: @file (# accessError:: (# do (errorNumbers.WriteAccessOnLstFileError,msg[])->catcher #) #); enter (whatToBeExpected,NoOfTerminals) do lastOKPos+1->errorPos; (if error[] = none then screen[]->error[]; '***WARNING: error stream in markError not specified. Using screen[] as error[]' ->error.putline; if); error.newLine; input.reset; error[]->errorReport; (# t: ^text do fullName->t[]; '.lst'->(t.copy).Append->lstFile.name; #); (if (lstFile.entry.path.head->dirWriteable) then (if lstFile.entry.writeable (# error:: (# do true->continue; (errorNumbers.otherFileError,msg[])->catcher #) #) then lstFile.openWrite; input.reset; lstFile[]->errorReport; lstFile.close; false->ok; ''->parseErrors; else (# t: @text do 'No write access to the file: "'->t; lstFile.name->t.append; '"'->t.putline; (errorNumbers.WriteAccessOnLstFileError,t[])->catcher #) if) else (# t: @text do 'No write access to the directory: "'->t; lstFile.entry.path.head->t.append; '"'->t.putline; (errorNumbers.WriteAccessOnLstFileError,t[])->catcher #) if); #) (* markError *) ; currentToken: @ (# val: @integer; enter val exit val #); advance: @| (# do get; cycle (# do inputPos->lastOKPos; (if nextCh // EOSchar then (if get = EOSchar then loop1: (if get = EOSchar then restart loop1 if); dash->currentToken; SUSPEND; else EOSchar->currentToken; SUSPEND; if); // '[' then (if get = '[' then beginGroup->currentToken; SUSPEND; get else '['->currentToken; SUSPEND if); // ']' then (if get = ']' then endGroup->currentToken; SUSPEND; get else ']'->currentToken; SUSPEND if); // '\'' then theText.clear; get; loop: (if nextCh // '\'' then leave loop; // '\\' then (if get // ascii.newLine then ascii.newline->theText.put; // 'n' then ascii.newline->theText.put // 't' then ascii.ht->theText.put // 'v' then ascii.vt->theText.put // 'b' then ascii.bs->theText.put // 'r' then ascii.cr->theText.put // 'f' then ascii.np->theText.put // 'a' then ascii.bel->theText.put // '\\' then '\\'->theText.put // '?' then '?'->theText.put // '\'' then '\''->theText.put // '"' then '"'->theText.put // EOF then ('"EOF reached while reading this string"',6) ->markerror else (# V: @integer; oneMore: @boolean; isDigit: (# bool: @boolean do (if ('0' <= nextCh) and (nextCh <= '7') then nextCh-'0'+V*8->V; true->bool if) exit bool #); do (if isDigit then get; (if isDigit then get; (if isDigit then get; if) if); V->theText.put if); restart loop #) if); get; restart loop // ascii.newLine then inputPos-1->inputPos; ('"End-of-line is not allowed in strings"',6)->markerror // EOF then ('"EOF reached while reading this string"',6)->markerror // ascii.nul then ('"Ascii NULL character reached while reading this string"',8)->markerror else nextCh->theText.put; get; restart loop if); string->currentToken; SUSPEND; get // '(' then (if get = '*' then (if firstComment then false->firstComment if); loop: (if get // '*' then loop1: (if get // '*' then nextCh->fgComment.put; restart loop1 // ')' then CommentSeparator2->fgComment.put; get; leave loop // EOF then ('"EOF reached while skipping this comment"',6) ->markerror // ascii.nul then ('"Ascii NULL character reached while skipping this comment"',8)->markerror else '*'->fgComment.put; nextCh->fgComment.put; restart loop if) // EOF then ('"EOF reached while skipping this comment"',6) ->markerror // ascii.nul then ('"Ascii NULL character reached while skipping this comment"',8)->markerror else nextCh->fgComment.put; restart loop if) else inputPos-1->inputPos; input.position-1->input.position; '('->currentToken; SUSPEND if) // EOF // ascii.fs then EOF->currentToken; SUSPEND; // ascii.nul then ('"Ascii NULL character reached in non classified situation"',8)->markerror else (if true // ('0' <= nextCh) and ('9' >= nextCh) then nextCh-'0'->theConst; get; loop: (if ('0' <= nextCh) and ('9' >= nextCh) then 10*theConst+nextCh-'0'->theConst; get; restart loop if); const->currentToken; SUSPEND; // ('A' <= (nextCh->ascii.upcase)) and ('Z' >= (nextCh->ascii.upcase)) // ('_' = nextCh) then theText.clear; nextCh->theText.put; get; loop: (if true // ('A' <= (nextCh->ascii.upcase)) and ('Z' >= (nextCh->ascii.upcase)) // ('0' <= nextCh) and ('9' >= nextCh) // ('_' = nextCh) then nextCh->theText.put; get; restart loop if); (if true // 'ORIGIN'->nameEqual then origin->currentToken; SUSPEND // 'INCLUDE'->nameEqual then include->currentToken; SUSPEND // 'BODY'->nameEqual then body->currentToken; SUSPEND // 'MDBODY'->nameEqual then mdbody->currentToken; SUSPEND else name->currentToken; SUSPEND if) // (0 <= nextCh) and (nextCh <= 32) then get else nextCh->currentToken; SUSPEND; get if) if) #) #); nextCh: @integer; theText: @text; theConst: @integer; accept: @ (# token: @integer; errorText: @text enter token do (if currentToken <> token then (if token // name then ('NAME',1)->markError; // string then ('STRING',1)->markError; // const then ('CONST',1)->markError; // origin then ('origin',1)->markError; // include then ('include',1)->markError; // body then ('body',1)->markError; // mdbody then ('mdbody',1)->markError; // beginGroup then ('[[',1)->markError; // endGroup then (']]',1)->markError; // dash then errorText.clear; EOSchar->errorText.put; EOSchar->errorText.put; (errorText,1)->markError; // EOF then ('EOF',1)->markError; // ascii.nul then ('Ascii NULL character',3)->markerror else errorText.clear; token->errorText.put; (errorText,1)->markError if) if) #); nameEqual: @ (# name: ^text enter name[] exit (theText[]->name.equalNCS) #); parsePropertyList: (# do parseProperty; loop: (if currentToken // semiColon then advance; CommentSeparator1->fgComment.put; parseProperty; restart loop // name // origin // include // body // mdbody then semiColon->accept if) #); parseProperty: @ (# propName: @text; pe: ^prop.propElement do (if currentToken // name then CommentSeparator3->fgComment.put; name->accept; theText->propName; advance; propName.copy ->prop.addProp (# ifPropExist:: (# do false->delete #); do loop: (if currentToken // name then CommentSeparator3->fgComment.put; theText.copy->addName; advance; restart loop // string then CommentSeparator3->fgComment.put; theText.copy->addString; advance; restart loop // const then CommentSeparator3->fgComment.put; theConst->addConst; advance; restart loop if) #) // origin then CommentSeparator3->fgComment.put; origin->accept; theText->propName; advance; string->accept; propName.copy ->prop.addProp (# ifPropExist:: (# do false->delete #); do (if currentToken = string then CommentSeparator3->fgComment.put; theText.copy->addString; advance; if) #); // include then CommentSeparator3->fgComment.put; include->accept; theText->propName; advance; string->accept; propName.copy ->prop.addProp (# ifPropExist:: (# do false->delete #); do loop: (if currentToken // string then CommentSeparator3->fgComment.put; theText.copy->addString; advance; restart loop // name // const then string->accept; // origin // include // body // mdbody then semiColon->accept if) #); // body then CommentSeparator3->fgComment.put; body->accept; theText->propName; advance; string->accept; propName.copy ->prop.addProp (# ifPropExist:: (# do false->delete #); do loop: (if currentToken = string then CommentSeparator3->fgComment.put; theText.copy->addString; advance; restart loop if) #) // mdbody then CommentSeparator3->fgComment.put; mdbody->accept; theText->propName; advance; name->accept; propName.copy ->prop.addProp (# ifPropExist:: (# do false->delete #); do loop: (if currentToken // name then CommentSeparator3->fgComment.put; theText.copy->addName; advance; string->accept; (if currentToken = string then CommentSeparator3->fgComment.put; theText.copy->addString; advance; restart loop if) // string // const then name->accept // origin // include // body // mdbody then semiColon->accept if) #) if) #) enter (input[],error[]) do 0->EOSchar; prop.proplist.clear; prop.init; none ->linklist[]; (* to cancel cached INCLUDE's *) true->ok; 0->inputPos; true->firstComment; fgComment.clear; advance; INNER propertyParser; 'Comment' ->prop.addProp (# ifPropExist:: (# do '**WARNING: Property Comment is predefined'->error.putline #); do fgComment.copy->addString; #); (*ESS: NO!!!!! (if ok then markAsChanged if);*) exit ok #); parseProperty: propertyParser (# do parsePropertyList #)
| 13.11 Propertyparser Interface | © 1991-2002 Mjølner Informatics |
[Modified: Friday October 6th 2000 at 11:20]
|