ORIGIN '~beta/basiclib/betaenv';
LIB_DEF 'mpsastlevel' '../lib';
INCLUDE '~beta/sysutils/pathhandler'
'~beta/containers/hashTable'
'property';
BODY 'private/astPrivate';
(*
* COPYRIGHT
* Copyright (C) Mjolner Informatics, 1986-93
* All rights reserved.
*)
-- LIB: Attributes --
(* This fragment contains the tree level interface to the abstract syntax trees
* and interface to the fragment library.
*) (* idx: 2 *)
astInterface:
(# <<SLOT astInterfaceLib:Attributes>>;
yggdrasilVersion:
(* describes the version of THIS(astInterface) *) (# exit 'v5.2' #);
ast:
(* Basic class, which is the super-pattern of all patterns describing
* abstract syntax trees. Ast's are stored in a special purpose format
* which is internally allocated in a repetition.
*)
(# <<SLOT astLib:Attributes>>;
frag: (* where THIS(ast) belongs *)
^fragmentForm;
symbol: (* the nonterminal symbol of THIS(ast) *)
(# lab: @integer
enter
(# enter lab ... #)
exit
(# ...
exit lab
#)
#);
father:
(* return the father of THIS(ast) or NONE, if we are in the root *)
(#
exit (# as: ^ast ... exit as[] #)
#);
son:<
(* returns the son of THIS(ast); only expanded-nodes
* may have a son - if no son, none is returned;
* for all other AST-nodes, none is returned
*)
(# theSon: ^AST do INNER exit theSon[] #);
nextBrother:
(# brother: ^ast
...
exit brother[]
#);
sonNo:
(* returns the sonNo of THIS(ast) in the father node *)
(# inx,finx,son: @integer
...
exit son
#);
kind:
(* return the subCategory of ast this node is *)
(#
exit (# kind: @integer ... exit kind #)
#);
equal:
(* determines if THIS(ast) and another ast-reference points to the
* same ast. This operations is to be used instead of testing
* reference-equivalence directly: instead of testing
* a1,a2: ^ast;
* (if a1[]=a2[] then ... if);
* you must test
* (if (a1[]->a2.equal) then ... if)
*)
(# comparedAst: ^ast;
enter comparedAst[]
exit (# eq: @boolean ... exit eq #)
#);
nearestCommonAncestor:
(* find the nearest common ancestor of THIS(ast) and the ast
* entered
*)
(# testAst,nca: ^ast; testSonNo,mySonNo: @integer
enter testAst[]
do ...
exit
(nca[],testSonNo,mySonNo)
(* TestSonNo is the number of the son where
* father-chain of the entered ast differs. MySonNo is
* the number of the son where father-chain THIS(ast)
* differs
*)
#);
lt:
(* Determine whether the ast entered or THIS(ast) will be met first
* in a preorder traversal of the tree. Return true if the ast
* entered comes first
*)
(# testAst: ^ast; testSonNo,mySonNo: @integer
enter testAst[]
do ...
exit (testSonNo < mySonNo)
#);
putAttribute:
(* save an integer value as an attribute to THIS(ast) *)
(# val,attributNo: @integer;
enter (val,attributNo)
...
#);
getAttribute:
(* get an integer-valued attribute *)
(# attributNo,val: @integer;
enter attributNo
...
exit val
#);
putNodeAttribute:
(* save an ast-reference as an attribute to THIS(ast) *)
(# val: ^ast; attributNo: @integer
enter (val[],attributno)
...
#);
getNodeAttribute:
(* get an ast-reference - valued attribute *)
(# attributNo: @integer; val: ^ast
enter attributno
...
exit val[]
#);
putSlotAttribute:
(* save an integer value as an attribute to THIS(ast) *)
(# val,attributNo: @integer;
enter (val,attributNo)
...
#);
getSlotAttribute:
(* get an integer-valued attribute *)
(# attributNo,val: @integer;
enter attributNo
...
exit val
#);
putSlotNodeAttribute:
(* save an ast-reference as an attribute to THIS(ast) *)
(# val: ^ast; attributNo: @integer
enter (val[],attributno)
...
#);
getSlotNodeAttribute: (* get an ast-reference - valued attribute *)
(# attributNo: @integer; val: ^ast
enter attributno
...
exit val[]
#);
addComment:
(* add a commment to THIS(ast). Overwrites existing comments *)
(# l: ^lexemText;
enter l[]
...
#);
getComment:
(* return the comment associated with THIS(ast) *)
(#
exit (# as: ^ast ... exit as[] #)
#);
getNextComment:
(* This is a special operation that only should be used by the
* prettyprinter. A comment c for at subAST is organized as
* follows:
* c = c1 c2 ... cn, where the positions of the ci's are:
* c1 son1 c2 son2 c3 .... cn sonn cn+1
* each ci can be further divided into a subsequence of comments
* that must be prettyprinted separately.
* NextComment scans all subcomments one of the time.
* A call of nextComment returns the next subcomment in the
* sequence of comments belonging to THIS(ast).
*
* if n is -2 the whole comment is empty and subcomment is none
* if n is -1 the subcomment is empty and 'subcomment' is none
* if n is 0 there is only one comment between the two sons or
* it is the last subcomment
* if n is 1 there are more than one subcomment and 'subcomment'
* contains the current one
* if n is 2 the whole comment has been scanned, 'subcomment'
* contains the last one
*
* The representation of the comment looks like this:
* ' xxx 21 yyy 2 zzz 21 aaa 2'
*
* where 1 (ascii 1) is the separator between the subcomments and
* 2 (ascii 2) is the subsequence separator
*
* and it should be prettyprinted like this:
* [* xxx *] son1 [* yyy *] [* zzz *] son2 [* aaa *]
*)
(# subcomment: ^text; n: @integer;
do (if getNextCommentComponent[]=NONE then
&|getNextCommentOp[]->getNextCommentComponent[]
if);
getNextCommentComponent->(subcomment[],n);
exit (subcomment[],n)
#);
getNextCommentComponent: (*private*)^|getNextCommentOp;
getNextCommentOp: (*private*)
(# subcomment: ^text; n: @integer
do ...
exit (subcomment[],n)
#);
insertSubcomments:
(* This is a special operation that only should be used by the
* editor Inserts the subcomments with index inx (1..n)
* Subcomments must include subsequence separators. THIS(ast)
* must already have a comment. An empty comment with separators
* can be created using the prettyprinter.
*)
(# subcomments: ^text; inx: @integer
enter (subcomments[],inx)
do ...
#);
setSubcomments:
(* This is a special operation that only should be used by the
* editor. Sets the subcomments corresponding to index inx (1..n)
* Subcomments must include subsequence separators. If
* subcomments is empty, the existing subcomments at index inx
* are deleted. THIS(ast) must already have a comment. An empty
* comment with separators can be created using the
* prettyprinter.
*)
(# subcomments: ^text; inx: @integer
enter (subcomments[],inx)
do ...
#);
getSubcomments:
(* This is a special operation that only should be used by the
* editor. Returns subcomments with index inx (1..n), including
* subsequence separators. If the node has no comment or the
* subcomments are empty the empty string is returned.
*)
(# subcomments: ^text; inx: @integer
enter (inx)
do ...
exit subcomments[]
#);
scanComments:
(*
* A comment c for at subAST is organized as follows:
* c = c1 c2 ... cn, where the positions of the ci's are:
* c1 son1 c2 son2 c3 .... cn sonn cn+1
* Each ci can be further divided into comments that must be
* prettyprinted separately.
* ScanComment scans all subcomments one of the time
* calling INNER for each subcomment.
* 'current' contains the current subcomment with indexes
* inx (1..n, the ci number) and subinx (1..n, the number in
* the subsequence)
*)
(# current: ^text; inx,subinx: @integer
do ...
#);
insertSubcomment:
(* Inserts subcomment with indexes inx and subinx
* THIS(ast) must already have a comment.
* An empty comment with separators
* can be created using the prettyprinter.
*)
(# subcomment: ^text; inx,subinx: @integer
enter (subcomment[],inx,subinx)
do ...
#);
setSubcomment:
(* Sets subcomment with indexes inx and subinx,
* If subcomment is empty, the existing subcomment is deleted.
* THIS(ast) must already have a comment.
* An empty comment with separators
* can be created using the prettyprinter.
*)
(# subcomment: ^text; inx,subinx: @integer
enter (subcomment[],inx,subinx)
do ...
#);
getSubcomment:
(* Returns subcomment with indexes inx and subinx,
* if the node has no comment or the subcomment is empty
* the empty string is returned
*)
(# subcomment: ^text; inx,subinx: @integer
enter (inx,subinx)
do ...
exit subcomment[]
#);
hasComment:
(* tells if there is a comment associated with THIS(ast) *)
(# has: @boolean ... exit has #);
hasCommentProp:
(#
exit (typeOfComment = 17)
#);
getCommentProp:
(# prop: ^propertyList;
do ...
exit prop[]
#);
setCommentProp:
(# prop: ^propertyList;
enter (prop[])
do ...
#);
typeOfComment:
(* sets or returns the type of THIS(comment) *)
(# type: @integer
enter
(# enter type ... #)
exit
(# ...
exit type
#)
#);
dump:< (* do a nearly human readable dump of THIS(ast) to a stream *)
(# level: @integer; dmp: ^stream;
enter (level,dmp[])
...
#);
copy: protect
(* make a copy of THIS(ast) with all sons. The enter-parameter
* tells which fragmentForm the copy shall belong to
*)
(# copyFrag: ^fragmentForm
enter copyFrag[]
exit
(# as: ^ast
...
exit as[]
#)
#);
match:<
(* pattern-matching. Returns true if the entered ast match
* THIS(ast)
*)
(# doesMatch: @boolean; treeToMatch: ^ast
enter treeTomatch[]
...
exit doesMatch
#);
hasSemanticError:
(* returns true if THIS(ast) has semantic errors *)
(#
enter
(# b: @boolean
enter b
do (b,1,1)->frag.a[index].%PutBits
#)
exit (1,1)->frag.a[index].%GetBits
#);
semanticError: (* if hasSemanticError, this is the errorNumber *)
(#
enter
(# errorNumber: @integer
enter errorNumber
...
#)
exit
(# errorNumber: @integer;
...
exit errorNumber
#)
#);
stopYggdrasil:< astException;
astException: astInterfaceException
(#
do INNER astException;
msg.newLine;
' index = '->msg.puttext;
(index)->msg.putInt;
' symbol = '->msg.puttext;
(symbol)->msg.putInt;
#);
<<SLOT astPrivateLib:Attributes>>;
index:
(* Private: architecture of an ast:
*
* | .... |
* -----------------
* index -> | prodno |
* -----------------
* | next brother | (if negative: -index to father)
* -----------------
* | first son | (for lexems: pointer to text)
* -----------------
* |first attribute|
* -----------------
* | .... |
*
*) @integer;
copyPrivate:< (* Private *)
(# theCopy: ^ast; theCopyInx: @integer; copyFrag: ^fragmentForm;
enter copyFrag[]
...
exit theCopyInx
#);
do INNER
#);
expanded: ast
(* this pattern describes all expanded ast *)
(# <<SLOT expandedLib:Attributes>>;
noOfsons:
(* return the number of sons of THIS(expanded) *)
(# sons: @integer;
do ...
exit sons
#);
son::< (#
do (1->frag.a[index+1].%getShort)*2
-> frag.indexToNode
-> theSon[]
#);
get:
(* get a son with a given son-number *)
(# i: @integer;
enter i
exit (# as: ^ast ... exit as[] #)
#);
put:
(* sets the entered ast to be a son of this son with a given
* son-number
*)
(# i: @integer;
s: ^ast;
notSameFragment:< astException
(* exception called if the entered ast is not in same fragment
* as THIS(expanded)
*)
(#
do INNER notSameFragment;
'Error in put. Inserted ast is not from same fragmentForm '
->msg.putline;
#);
enter (i,s[])
do ...
#);
scan:
(* iterates over all sons *)
(# current: ^ast; currentSonNo: @integer;
do ...
#);
suffixWalk:
(* make a preorder traversal of the tree with THIS(expanded) as
* root. cutIf can be used to cut the traversal of some sub-ast's
*)
(# cutIf:<
(# prod: @integer; toCut: @boolean
enter prod
do false->toCut; INNER
exit toCut
#);
current: (* the ast-iterator *) ^ast;
do ...
#);
suffixWalkforProd:
(* make a preorder traversal of the tree with THIS(expanded) as
* root. Will only call INNER for ast's which have the symbol
* 'prod'. cutIf can be used to cut the traversal of some sub-ast's
*)
(# scanCat:< ast;
cutIf:<
(# prod: @integer; toCut: @boolean
enter prod
do false->toCut; INNER
exit toCut
#);
current: (* the ast-iterator *) ^scanCat;
prod: @integer;
enter prod
do ...
#);
insert:
(* insert an ast before a son with the given son-number. Must
* externally only be called for lists
*)
(# i: @integer;
s: ^ast;
notSameFragment:< astException
(* exception called if the entered ast is not in same fragment
* as THIS(expanded)
*)
(#
do INNER notSameFragment;
'Error in put. inserted ast is not from same fragmentForm '
->msg.putline;
#);
enter (i,s[])
do ...
#);
getson1:
(* optimized version of getson1: (# exit 1 -> get #) *)
(#
exit (1->frag.a[index+1].%getShort)*2
->frag.indexToNode
#);
getson2: (# exit 2->get #);
getson3: (# exit 3->get #);
getson4: (# exit 4->get #);
getson5: (# exit 5->get #);
getson6: (# exit 6->get #);
getson7: (# exit 7->get #);
getson8: (# exit 8->get #);
getson9: (# exit 9->get #);
putson1: (# a: ^ast enter a[] do (1,a[])->put #);
putson2: (# a: ^ast enter a[] do (2,a[])->put #);
putson3: (# a: ^ast enter a[] do (3,a[])->put #);
putson4: (# a: ^ast enter a[] do (4,a[])->put #);
putson5: (# a: ^ast enter a[] do (5,a[])->put #);
putson6: (# a: ^ast enter a[] do (6,a[])->put #);
putson7: (# a: ^ast enter a[] do (7,a[])->put #);
putson8: (# a: ^ast enter a[] do (8,a[])->put #);
putson9: (# a: ^ast enter a[] do (9,a[])->put #);
<<SLOT expandedPrivate:Attributes>>;
dump::< (* Private *)
(# do ... #);
match::< (* Private *)
(# do ... #);
copyPrivate::< (* Private *)
(# do ... #);
do INNER ;
#);
cons: expanded
(* describes ast's derived from a constructor-production *)
(# <<SLOT consLib:Attributes>>;
delete:
(* delete a son with the given son-number. Inserts an unExpanded
* instead
*)
(# sonnr: @integer;
enter sonnr
do ...
#);
dump::< (* Private *)
(#
do 'CONS'->dmp.puttext; INNER
#)
#);
list: expanded
(* describes ast's derived from a list-production *)
(# <<SLOT listLib:Attributes>>;
sonCat:< ast;
newScan: (* iterates over all sons *)
(# predefined:< (# current: ^Ast enter current[] do INNER #);
a: ^ast;
current: ^sonCat;
currentSonNo: @integer;
do ...
#);
append:
(* append a son to the list *)
(# a: ^ast; enter a[] do (noOfSons+1,a[])->insert; #);
delete: (* delete the son with the given son-number from the list *)
(# sonnr: @integer;
enter sonnr
do ...
#);
dump::< (* Private *)
(#
do 'LIST'->dmp.puttext;
INNER
#);
#);
lexem: ast
(* describes all ast's derived from one of the predefined
* nonterminals
*)
(# <<SLOT lexemLib:Attributes>> #);
lexemText: lexem
(* describes all ast's having textual contents *)
(# <<SLOT lexemTextLib:Attributes>>;
getText: (* get the textual content *)
(# t: ^text;
do &text[]->t[]; ...
exit t[]
#);
putText: (* set the textual content *)
(# t: ^text;
enter t[]
do ...
#);
clear: (* clear the textual content *)
...;
getChar: (* get a char *)
(# index: @integer; ch: @char
enter index
do ...
exit ch
#);
putChar: (* append a char to the textual content *)
(# c: @char;
enter c
do ...
#);
curLength: (* sets or returns the length of the textual contents *)
(# l: @integer
enter
(#
enter l
do ...
#)
exit
(# ...
exit l
#)
#);
<<SLOT lexemTextPrivate:Attributes>>;
dump::< (* Private *)
(#
do INNER ;
'^'->dmp.put;
getText->dmp.puttext
#);
copyPrivate::< (* Private *)
(# theLexCopy: ^lexemText
do theCopy[]->theLexCopy[];
getText->theLexCopy.puttext;
INNER
#);
match::< (* Private *)
(# theMatchLexem: ^lexemText;
theT,theMatchText: ^text;
...
#)
#);
nameDecl: lexemText
(* describes ast's derived from the predefined nonterminal <nameDecl> *)
(# <<SLOT nameDeclLib:Attributes>>;
exit prodNo.nameDecl
#);
nameAppl: lexemText
(* describes ast derived from the predefined nonterminal <nameAppl> *)
(# <<SLOT nameApplLib:Attributes>>;
exit prodNo.nameAppl
#);
string: lexemText
(* describes ast derived from the predefined nonterminal <string> *)
(# <<SLOT stringLib:Attributes>> exit prodNo.string #);
comment: lexemText
(# <<SLOT commentLib:Attributes>>;
commentType:
(# type: @integer
enter
(# enter type ... #)
exit
(# ...
exit type
#)
#);
copyPrivate::< (* Private *)
(# ... #);
exit prodNo.comment
#);
const: lexemText
(* describes ast derived from the predefined nonterminal <const> *)
(# <<SLOT constLib:Attributes>>;
putValue:
(# val: @integer;
enter val
do ...
#);
getValue:
(# val: @integer;
do ...
exit val
#);
dump::< (* Private *)
(# do INNER ; '&'->dmp.put; getText->dmp.putText #);
copyPrivate::< (* Private *)
(# theCnCopy: ^const;
do theCopy[]->theCnCopy[]; getText->theCnCopy.putText;
#);
exit prodNo.const
#);
unExpanded: ast (* describes ast's which have not been derived yet *)
(# <<SLOT unExpandedLib:Attributes>>;
nonterminalSymbol:
(* describes which symbol, THIS(unExpanded) may derive.
* THIS(unexpanded).symbol returns prodNo.unExpanded
*)
(#
enter
(# val: @integer
enter val
do (val,1)->frag.a[index+1].%putShort
#)
exit 1->frag.a[index+1].%GetSignedShort
#);
isSlot:
(# b: @boolean
enter (# enter b do (b,0,1)->frag.a[index].%PutBits #)
exit (0,1)->frag.a[index].%GetBits->b
#);
theSlot:
(#
enter
(# o: ^slotDesc
enter o[]
...
#)
exit
(# sd: ^slotDesc
...
exit sd[]
#)
#);
sy: (* Private *) @integer;
dump::< (* Private *) (# ... #);
copyPrivate::< (* Private *)
(# do ... #);
do prodNo.unExpanded->sy;
INNER
exit sy
#);
optional: unExpanded
(* nodes in the tree which are empty (for optionals) are generated as
* instances of 'optional'
*)
(# <<SLOT optionalLib:Attributes>>;
dump::< (* Private *)
(# do '#'->dmp.put; INNER #);
do prodNo.optional->sy
#);
slotDesc: ast
(# <<SLOT slotDescLib:Attributes>>;
name:
(#
enter
(# t: ^text;
enter t[]
do ...
#)
exit
(# c: ^comment
...
exit c.getText
#)
#);
category:
(# f: ^unExpanded do father->f[]; exit f.nonterminalSymbol #);
isBound: (* Private *) @boolean;
node: (* Private *)
(# father: @integer; ff: ^fragmentForm
...
exit (father,ff[])
#);
copyPrivate::< (* Private *)
(#
do ...
#);
dump::< (* Private *) (# ... #);
exit prodNo.slotDesc
#);
nonterminalSymbol:
(* may be used to describe symbol numbers *)
(# <<SLOT nonterminalSymbolLib:Attributes>>;
symbol: @integer;
predefined:
(#
exit (symbol <= 0)
#);
isLexem:
(#
exit ((symbol < - 2) and (symbol > - 7))
#)
enter symbol
exit symbol
#);
(*--------------------- Fragment patterns ------------------------------*)
formType: (# exit 0 #);
groupType: (# exit 1 #);
fragment:
(* Abstract super-pattern for fragments. A fragment has a unique
* identification in form of a hierarchical name: '/foo1/foo2/.../foon';
* '/foo1/foo2/...' is called the path of the fragment; 'foo' is called
* the (local) name. Only name needs to be stored since the path can be
* fetched recursively from the father.
*)
(# <<SLOT fragmentLib:Attributes>>;
name:
(* exit the local name of THIS(fragment) *)
(# enter nameT[] exit nameT[] #);
fullName: (* exit the full name (path/name) of THIS(fragment) *)
(# n: ^Text ... exit n[] #);
father:
(#
enter fatherR[]
exit fatherR[]
#);
isOpen:
(* returns true if THIS(fragment) has been opened *) @boolean;
close:< (* Close THIS(fragment) *)
(#
do (if changed then markAsChanged if);
INNER ;
false->isOpen
#);
type: (* returns one of formType or groupType *)
(# exit fragType #);
init:<
(#
do &propertyList[]->prop[]; prop.init; false->changed; INNER
#);
reset:<
(* reset fragmentForm to be as if it has just been parsed up *)
(# do INNER #);
modtime: (* time of last visit of file-representation *) @integer;
markAsChanged: protect
(* call this when you want to save some changes *)
(# ... #);
changed: @boolean;
checkDiskRepresentation:<
(* called when it should be checked, if the disk-representation
* of the fragment have been changed by another fragment. If it
* have, the internal state of the fragment is updated according to
* the disk-representation
*)
(# haveBeenChanged: @boolean; error: ^stream
enter error[]
do ...
exit haveBeenChanged
#);
diskFileName:< (* returns the filename of the disk-representation *)
(# t: ^text do &text[]->t[]; INNER exit t[] #);
textFileName:<
(* returns the file-name of the text-representation of
* THIS(fragment)
*)
(# t: ^text do &text[]->t[]; INNER exit t[] #);
origin: (# enter originR[] exit originR[] #);
bind:< (* bind the fragment f inside THIS(fragment) *)
(# f: ^fragmentForm; op: ^slotDesc
enter f[]
...
exit op[]
#);
bindToOrigin:
(# f: ^FragmentForm; op: ^slotDesc
enter f[]
...
exit op[]
#);
setupOrigin:
(# error: ^stream
enter error[]
do ...
#);
prop: ^propertyList;
pack:<
(* Private: pack representation into byte stream *)
(# fileName: (* if none diskFileName is used *) ^text
enter fileName[]
do INNER
#);
unpack:< (* Private: unpack rep. from bytestream *)
(# fileName: (* if none diskFileName is used *) ^text;
error: ^stream
enter (fileName[],error[])
do INNER
#);
bindMark:
(* Private: true => attempting to bind slots in THIS(fragment) *)
@boolean;
nameT: (* Private *) ^text;
fullNameT: (* Private *) ^text;
fatherR: (* Private: the enclosing group *) ^fragmentGroup;
fragType: (* Private *) @integer;
originR: (* Private: Attribute where THIS(fragment) 'belongs' *)
^fragment;
ffNameSeparatorChar: (* Private *) (# exit '-' #);
catcher: handler (* Private *)
(# ... #);
do INNER
#);
newFragmentGroup:
(* returns a new instance of fragmentGroup *)
(# g: ^fragmentGroup do &fragmentGroup[]->g[]; g.init; exit g[] #);
fragmentGroup: fragment (* This is a group of fragments *)
(# <<SLOT fragmentGroupLib:Attributes>>;
scan:
(* scans through all fragment forms in this(fragmentGroup) *)
(# current: ^fragment
...
#);
scanIncludes:
(* scans through all included fragmentGroups in
* this(fragmentGroup)
*)
(# current: ^linklisttype.link;
...
#);
scanSlots:
(* scans through all SLOTs in this(fragmentGroup) *)
(# current: ^slotDesc
...
#);
open: protect
(* This operation opens a local fragment, localPath, of this group.
* LocalPath may be a local name of the form 'foo' or a local path
* 'foo1/foo2/.../foon' which will be interpreted local to this
* group
*)
(# localPath: ^text;
f: ^fragment;
g: ^fragmentGroup;
error: ^stream;
groupInx,dirInx: @integer
enter (localPath[],error[])
...
exit f[]
#);
close::<
(#
...
#);
fragmentListElement:
(# f: ^fragment;
type: @integer;
name: ^text;
localName,
fullNameOfLink:
(* ought to be in a subpattern, Only o.k. for link-type *)
^text;
open:
(# error: ^stream
enter error[]
...
exit f[]
#);
<<SLOT fragmentListElementPrivate:Attributes>>
#);
fragmentList:
^fragmentListDescription;
loadIncludes: ...;
linkListType:
(* to cache include links *)
(# link:
(# linkname: ^text;
fullname: @
(# fn: ^text
...
exit fn[]
#);
next: ^link
#);
head: ^link
#);
linkList: ^linkListType;
fragmentListDescription: containerList
(# element::< fragmentListElement;
deleteLocalName: (* delete the fragment with the local name n *)
(# n: ^text (* the local path *)
enter n[]
...
#);
find:
(* find a local fragment. If the fragment is not open return
* NONE
*)
(# n: ^text (* the local path *) ; r: ^fragment
enter n[]
...
exit r[]
#);
open:
(* Find a local fragment. If the fragment is not open then
* open it
*)
(# f: ^fragment;
n: ^text;
e: ^element;
error: ^stream;
removeHeadingSlashes:
(* this routine removes '/' 's at the head of a
* text
*)
(# t: ^text; ch: @char
enter t[]
do 0->t.setPos;
loop:
(if (t.get->ch)='/' then restart loop if);
(if (t.pos > 1) then
(1,t.pos-1)->t.delete
if)
exit t
#);
enter (n[],error[])
...
exit f[]
#);
insertFragment: protect
(# f: ^fragment;
newElement: ^element;
alreadyThere:< (* exception, which may be called *)
astInterfaceException
enter f[]
...
#);
addFragment: insertFragment (# do newElement[]->append #);
insertFragmentBefore: insertFragment
(# before: ^theCellType
enter before[]
do (newElement[],before[])->insertBefore
#);
insertFragmentAfter: insertFragment
(# after: ^theCellType
enter after[]
do (newElement[],after[])->insertAfter
#);
<<SLOT fragmentListDescriptorPrivate:Attributes>>
#);
defaultGrammar:
^treeLevel;
saveAs: protect
(* save THIS(FragmentGroup) using the name fullname *)
(# fullname: ^Text
enter fullname[]
do ...
#);
saveBackup: protect
(* save THIS(FragmentGroup) using the name diskFileName+ext *)
(# ext: ^Text
enter ext[]
do ...
#);
restoreBackup: protect
(* restore THIS(FragmentGroup) using the name diskFileName+ext *)
(# ext: ^Text
enter ext[]
do ...
#);
diskFileName::<
(#
...
#);
textFileName::<
(# ... #);
isRealOpen:
(# opened: @Boolean;
...
exit opened
#);
realOpen: protect
(* only to be used by the compiler *)
(# do ... #);
parse: (* for parsing a fragmentGroup *)
(# groupParser:
...;
parseErrors:< (* exception called if parse-errors *)
astInterfaceException;
fatalParseError:< astInterfaceException
(# errNo: @integer enter errNo do INNER #);
doubleFormDeclaration:<
(* exception called if two fragmentForms with the same name *)
astInterfaceException;
inputname: ^text;
error: ^stream;
ok: @boolean
enter (inputname[],error[])
do groupParser
exit ok
#);
init::< (# ... #);
bind::<
(#
do ...
#);
(* lock/unlock/locked operations *)
lock:
(* operation to signal to the rest of the users of this MPS,
* that I will be working on this fg, and it may be in
* inconsistent state
*)
(# ... #);
unlock:
(* operation to signal to the rest of the users of this MPS,
* that I am releasing the lock on this fg.
*)
(# ... #);
locked: @booleanValue;
(********** PRIVATE PART *********************)
pack::< (* Private *)
(# ... #);
unpack::< (* Private *)
(#
do ...
#);
checkDiskRepresentation::< (* Private *)
(# ... #);
isDirectory:
(* Private: true if the group is not a 'real' group but a
* directory
*) @boolean;
controller: @ (* used by the control module in the compiler *)
(# status: @integer;
ancestorTime: @integer;
ancestorsChecked: @boolean;
doneCheck: @boolean;
groupT: @Integer;
printName: ^text;
#);
private: @...;
#) (* fragmentGroup *);
newFragmentForm: (* returns a new instance of fragmentForm *)
(# g: ^treeLevel; f: ^fragmentForm
enter g[]
do &fragmentForm[]->f[]; g[]->f.grammar[]; f.init;
exit f[]
#);
fragmentForm: fragment
(* This is the basic form of a fragment defined by means of a general
* sentential form
*)
(# <<SLOT fragmentFormLib:Attributes>>;
category:
(# sy: @integer
...
exit sy
#);
xtheGsForm: (# exit (root.index,THIS(fragmentForm)[]) #);
fragNode: (# exit (0,THIS(fragmentForm)[]) #);
print:
(#
do 'Print called of fragmentForm '->screen.puttext;
fullName->screen.puttext;
screen.newLine;
#);
binding: (* The SLOT bound by THIS(fragmentForm) *) ^slotDesc;
modificationStatus: @integer;
root:
(* the root symbol of the ast kept in the array. Set by the
* parser
*) ^ast;
recomputeSlotChain:
(# do ...; #);
scanSlots:
(* access operations: scan all SLOTs in THIS(fragmentForm) *)
(# inx: @integer; current: ^slotDesc;
...
#);
grammar: ^treeLevel;
indexToNode:
(# inx: @integer;
as: ^ast;
indexOutOfRange:<
astInterfaceException;
noSuchSymbol:< astInterfaceException;
grammarGenRefArrayError:< astInterfaceException;
enter inx
do ...
exit as[]
#);
<<SLOT fragmentFormPrivate:Attributes>>;
a: (* Private *) [initialLength] @integer;
curtop: (* Private: current heapTop in the array a *) @integer;
l: (* Private *) [initialLength] @integer;
lcurtop: (* Private: current heapTop in the array 'l' *) @integer;
initialLength:< (* Private *)
(# max: @integer do 200->max; INNER exit max #);
firstSlot:
(* Private: The index of the first SLOT in the array a. The SLOTs
* are linked together through the 'slotUsage-field' of SLOTs
*) @integer;
diskFileName::< (* Private *)
(# do fatherR.diskFileName->t[] #);
textFileName::< (* Private *)
(# do fatherR.textFileName->t[] #);
import: @ (* Private *)
(* An indexed collection of fragments referred by
* THIS(fragmentForm)
*)
(# impL: ^list;
inxC: @integer;
element: (# n: ^text; f: ^fragmentForm #);
list:
(# noOfElements:<
(# nu: @integer; do 10->nu; INNER exit nu #);
l: [noOfElements] ^element;
#);
<<SLOT fragmentFormImportPrivate:Attributes>>
#);
rootInx: @integer;
init::< (* Private *)
(#
...
#);
reset::< (* Private *)
(# ... #);
private: @...;
#);
astFileExtension:
(* exits the filename extension for AST files on the particular
* architecture (the extension differs e.g. for big- and little endian
* architectures). See e.g. initialization in astBody.bet
*) (# exit astFileExt[] #);
parserFileExtension:
(* exits the filename extension for parser table files on the particular
* architecture (the extension differs e.g. for big- and little endian
* architectures). See e.g. initialization in astBody.bet
*) (# exit parserFileExt[] #);
ppFileExtension:
(* exits the filename extension for pretty-printer table files on the
* particular architecture (the extension differs e.g. for big- and
* little endian architectures). See e.g. initialization in astBody.bet
*) (# exit ppFileExt[] #);
astFileExt: (* Private *) ^text;
parserFileExt: (* Private *) ^text;
ppFileExt: (* Private *) ^text;
(************** END The Fragment Library END ***************)
top: @
(# init: (# ... #);
groupTable: @HashTable
(# element::
(# fullname: ^Text;
g: ^FragmentGroup;
open:
(# error: ^Stream;
enter error[]
...
exit g[]
#);
#);
dummy: @Element;
hashFunction::
(# inx: @Integer;
do L:
(for i: 26 repeat
e.fullname.lgth-i+1->inx;
(if inx < 1 then leave L if);
e.fullname.T[inx]+value->value;
for)
#);
equal::
(# do left.fullname[]->right.fullname.equal->value #);
rangeInitial:: (# do 500->value #);
find:
(* find a fragment group. If the fragment is not open return
* NONE
*)
(# fullName: ^text (* the path *) ; g: ^fragmentGroup
enter fullName[]
...
exit g[]
#);
open:
(* Find a local fragment. If the fragment is not open then
* open it
*)
(# g: ^fragmentgroup;
fullName: ^text;
e: ^element;
error: ^stream;
removeHeadingSlashes:
(* this routine removes '/' 's at the head of a
* text
*)
(# t: ^text; ch: @char
enter t[]
do 0->t.setPos;
loop:
(if (t.get->ch)='/' then restart loop if);
(if (t.pos > 1) then
(1,t.pos-1)->t.delete
if)
exit t
#);
enter (fullName[],error[])
...
exit g[]
#);
<<SLOT topTablePrivate:Attributes>>
#);
open: protect
(* This operation opens a fragmentgroup file: fileName
*)
(# fileName: ^text;
g: ^fragmentGroup;
f: ^fragment;
error: ^stream
enter (fileName[],error[])
do ...;
g[]->f[];
exit f[]
#);
newGroup: (* make a new group with top as father *)
(# fullname: ^Text;
fg: ^FragmentGroup;
alreadyOpen:< astInterfaceException;
enter fullname[]
...
exit fg[]
#);
close: (* close FragmentGroup fg *)
(# fg: ^fragmentGroup;
enter fg[]
...
#);
namedClose: (* close FragmentGroup fullname *)
(# fullname: ^text
enter fullname[]
...
#);
delete:
(* delete FragmentGroup fg *)
(# fg: ^fragmentGroup;
enter fg[]
...
#);
insert:
(* insert a FragmentGroup into top table *)
(# fg: ^fragmentGroup;
enter fg[]
do ...
#);
isOpen:
(* return Group fullname if it is already open, otherwise NONE *)
(# fullname: ^Text; fg: ^FragmentGroup;
enter fullname[]
...
exit fg[]
#);
topGroup: ^FragmentGroup;
catcher: handler (* Private *)
(# ... #);
#);
(* end of top *)
parseSymbolDescriptor:
(# terminals: (* is dynamically expanded *) [1]
^text;
nonterminals: (* is dynamically expanded *) [1] @integer;
#);
errorReporter:
(* error-reporter pattern. Create a specialization of this pattern if
* you want to do your own error-reporting
*)
(# frag: ^fragment;
errorStream: ^stream;
beforeFirstError:< object;
afterLastError:< object;
forEachError:<
(# streamPos,startLineNo: @integer;
errorLines:
(* 1, 2 or 3 lines of text before the
* error. Approx. 100 chars
*) @text;
errorPos: (* the pos in errorLines of the error *) @integer;
legalSymbols: ^parseSymbolDescriptor
enter (streamPos,startLineNo,errorLines,errorPos (*inx*) ,legalSymbols[])
do INNER
#);
#);
theErrorReporter:
(* the error reporter which will be called from the fragmentGroupparser
* or from fragmentForm.parser.errorReport
*) ^errorReporter;
treeLevel:
(* prefix for descriptions of grammars *)
(# <<SLOT treeLevelLib:Attributes>>;
grammarAst:
(* if not NONE this point to the form of the ast describing the
* grammar
*) ^fragmentForm;
symbolToName: (* gives a human-readable name for a symbol-number *)
(# symbol: @integer; t: ^text;
enter symbol
do &text[]->t[]; ...
exit t[]
#);
symbolToAst:
(# symbol: @integer;
as: ^ast;
enter symbol
...
exit as[]
#);
newAst: (* returns a new instance of ast *)
(# prod: @integer; as: ^ast; frag: ^fragmentForm;
enter (prod,frag[])
do ...
exit as[]
#);
newAstWithoutSons:
(# prod: @integer;
as: ^ast;
frag: ^fragmentForm;
enter (prod,frag[])
...
exit as[]
#);
newLexemText: (* returns a new instance of lexemText *)
(# length: @integer;
prod: @integer;
frag: ^fragmentForm;
inx,base: @integer;
enter
(#
enter (prod,length,frag[])
...
#)
exit
(# as: ^ast
...
exit as[]
#)
#);
newConst: (* returns a new instance of const *)
(# c: ^const; frag: ^fragmentForm
enter frag[]
...
exit c[]
#);
newUnexpanded:
(* returns a new instance of unExpanded *)
(# s: ^unExpanded; syncatNo: @integer; frag: ^fragmentForm
enter (syncatNo,frag[])
...
exit s[]
#);
newOptional:
(* returns a new instance of optional *)
(# s: ^optional; syncatNo: @integer; frag: ^fragmentForm;
enter (syncatNo,frag[])
...
exit s[]
#);
newSlot:
(* returns a new instance of slotDesc *)
(# s: ^slotDesc; frag: ^fragmentForm
enter frag[]
...
exit s[]
#);
version:< (* returns the grammar version *)
integerObject (# ... #);
grammarIdentification:< (* the grammar name *)
(# theGrammarName: ^text
...
exit theGrammarName[]
#);
suffix:<
(* the file-name extension used for files containing programs
* derived from this grammar. Default extension is '.text'.
*)
(# theSuffix: ^text
...
exit theSuffix[]
#);
init:<
(# do ... #);
parser: @parse;
parse:
(# errorReport:
(* produce an errorReport on stream if the last parse did not
* succeed
*)
(# input,error: ^stream;
enter (input[],error[])
do ...
#);
findSymbolNo:
(* given a text-string, find the nonterminal-symbol, that has
* that name
*)
(# symbol: ^text; no: @integer
enter symbol[]
...
exit no
#);
input,error: ^stream;
goalSymbol:
@nonterminalSymbol;
a2sI: ^ a2sInterface;
frag: ^fragmentForm;
ok,haveBeenInitialized: @boolean;
parseEndPos: @integer;
lastCh: @char;
privatePart: @...;
initialize:
(# fileName: ^text;
isEos:<
(* '--' may be considered as end-of-stream *)
booleanValue(# do true->value #);
longLexems:<
(* the lexems may be long (multi-word lexems) *)
booleanValue;
dashNames:< (* dash '-' may be allowed in indentifiers *)
booleanValue;
caseSensitive:< (* allows keywords to be case sensitive *)
booleanValue;
EOLasComEnd:< (* EOL is also accepted as end-of-comment *)
booleanValue;
SplitString:<(* a string may be split into several units
* 'xxx' 'yyy' is lexed as 'xxx<0>yyy'
*)
BooleanValue
enter fileName[]
...
#);
doParse: protect
(# catcher: handler (* Private *)
(# ... #)
enter (goalSymbol,input[],error[],frag[])
do ...
exit ok
#);
commentId:
(* declared to be able to get the value of comment inside the
* comment-binding in the parser
*) (# exit comment #);
enter (goalSymbol,input[],a2sI[],error[],frag[])
do doParse;
exit ok
#);
<<SLOT treeLevelPrivate:Attributes>>;
private: @ ...;
kindArray: (* Private *) [maxProductions] @integer;
nodeClassArray: (* Private *) [maxProductions] @integer;
sonArray: (* Private *) [maxProductions] @integer;
roomArray: (* Private *) [maxProductions] @integer;
genRefArray: (* Private *) [maxProductions] ##ast;
prettyPrinter: (* Private *) ^object;
maxProductions:< integerObject (* Private *)
(# do 400->value; INNER #);
#);
kinds: @
(# interior: (# exit 1 #);
unExpanded: (# exit 2 #);
optional: (# exit 3 #);
nameAppl: (# exit 4 #);
nameDecl: (# exit 5 #);
string: (# exit 6 #);
const: (# exit 7 #);
comment: (# exit 8 #);
slotDesc: (# exit 9 #);
list: (* this will only be returned by 'nodeClass' *)
(# exit 117 #);
cons: (* this will only be returned by 'nodeClass' *)
(# exit 118 #);
dummy: (* temporary declaration. Is never returned *)
(# exit - 317 #)
#);
prodNo: @
(# unExpanded: (# exit - 1 #);
optional: (# exit - 2 #);
nameAppl: (# exit - 3 #);
nameDecl: (# exit - 4 #);
const: (# exit - 5 #);
string: (# exit - 6 #);
comment: (# exit - 7 #);
slotDesc: (# exit - 8 #)
#);
CommentSeparator1: (# exit 1 #);
(* Separation of comments *)
CommentSeparator2: (# exit 2 #);
(* Separation of comments in same son *)
CommentSeparator3: (# exit 3 #);
(* Separation of comments in properties *)
CommentSieve: [256] @Char;
printComment:
(# comment: ^Text; output: ^Stream;
enter (comment[],output[])
...
#);
undefinedGrammarName:
(* describes unknown grammars *) (# exit '????' #);
undefinedVersion: (* describes unknown versions of grammars *)
(# exit - 1 #);
grammarTable: @
(# BETA,propertyGrammar,meta,pretty:
(* some different grammars, which might by instantiated by the
* application
*) ^treeLevel;
noOfKnownGrammars: @integer;
scan:
(# current: ^treeLevel;
currentName, currentExtension, currentPath: ^text
...
#);
scanExtensions:
(# currentExtension: ^text
...
#);
legalExtension: booleanValue
(# ext: ^text
enter ext[]
...
#);
find:
(# grammarName: ^text;
error: ^stream;
ifNotFound:< astInterfaceException
(* exception called if grammar not found *)
(# ... #);
noParserAvailable:< astInterfaceNotification
(* notification invoked if no parser is available
* for this grammar
*)
(# ... #);
accessError:< astInterfaceException
(* invoked if any access error occurs during the
* search of grammars
*);
MPSerror:< astInterfaceException
(* invoked if any MPS error occurs during the
* opening of grammars
*);
startParsing:<
(* invoked if parsing is done during the opening of
* grammars
*)
(# do INNER #);
inx: @integer;
thename: @text;
treelevelGrammarTableFindCatcher: (* Private *) @handler
(# ... #)
enter (grammarName[],error[])
do ...
exit table[inx].gram[]
#);
element: (# name, extension, path: ^text; gram: ^treelevel #);
table: [0] (* Private *) ^element;
tableCheck: (* private *)
...;
insert: (* Private *)
(# theGrammar: ^treeLevel
enter theGrammar[]
...
#);
insertMetagrammar:
(* Private: an instance of metaGrammar must be inserted into
* grammarTable before any usages of grammarTable
*)
(# location: ^text
enter (meta[],location[])
...
#)
#);
registerGrammar:
(# name, ext, path: ^text; inx: @integer;
enter (name[], ext[], path[])
...
#);
grammarFinder:
(* create subpatterns of this pattern to implement your strategy for
* looking-up grammars. The fragment: findGrammar.bet contains such a
* subpattern, implementing the standard look-up method used in the
* Mjolner BETA System
*)
(# grammar: ^text;
error: ^stream;
installed: @boolean;
noRegisteredGrammars:< astInterfaceException
(* invoked if no grammars have been registered. If
* grammars are registered during this exception, and
* control is returned to grammarFinder, the registered
* grammars will be used.
*)
(# ... #);
registerGrammars:< (* invoked to register the grammars *)
(# error: ^stream;
enter error[]
...
#);
registeredGrammars:<
(* may return a fragmentGroup containing the registered grammars *)
(# grammarsGroup: ^fragmentGroup
do INNER
exit grammarsGroup[]
#);
enter (grammar[],error[])
(* here the look-up for a grammar should takes place. Either by
* looking somehow amoung the previously registered grammars, or by
* using some dynamic grammar look-up method
*)
...
exit installed
(* true if new grammar installed in grammarTable *)
#);
defaultGrammarFinder:<
(* default grammarFinder installed by astLevelInit *) grammarFinder;
grammarMissing:
(* called when a grammar is missing.
* grammarMissing.registerGrammars is invoked in astLevelInit
*) ^grammarFinder;
thePathHandler: @fileNameConverter;
stripPathName:
(* Strips last filename from a path specification in order to
* conform with the new pathHandler.
*)
(# PN,newPN: ^text; ix: @integer;
enter PN[]
do directoryChar->PN.findAll(# do inx->ix #);
(if ix=0 then
none ->newPN[]
else
(* terminating directoryChar is not removed due to 'strange'
* behavior in localPath
*)
(1,ix)->PN.sub->newPN[]
if)
exit newPN[]
#);
expandToFullPath:
(# name: ^text;
enter name[]
exit
(name[],currentDirectory)->thePathHandler.convertFilePath
#);
offendingFormName:
(* set in case of a doubleDeclaration in fragmentForm names *) ^text;
trace: @
(* different tracing possibilities. I.e. to trace open of
* fragments use
* (trace.fragmentOpen,true) -> trace.set;
* To activate tracing through the BETA compiler,
* set compileroption=number given here+400
* (e.g. "beta -s 490 ..." to activate trace of slot bindings).
* The trace will be delivered on the stream trace.str. This may be
* set by e.g.:
* traceFile[] -> trace.output;
* By default, trace is delivered on screen.
*)
(# fragmentOpen: (# exit 1 #);
onParse: (# exit 2 #);
topOpen: (# exit 3 #);
fragmentClose: (# exit 4 #);
topClose: (# exit 4 #);
compactOpen: (# exit 10 #);
grammars: (# exit 20 #);
parsingComments: (# exit 30 #);
getnextComment: (# exit 31 #);
editingComments: (# exit 32 #);
parser: (# exit 50 #);
getBinding: (# exit 90 #);
getBindingMark: (# exit 91 #);
set: (* call this to trace something in the astInterface *)
(# no: @integer; on: @boolean;
enter (no,on)
...
#);
output:
(# str: ^stream
enter str[]
...
#);
active: (* true iff any trace options are set *) @boolean;
d: (* Private *) [100] @boolean;
private: @...
#);
options: @
(* different options available. I.e. to set these options use
* true -> options.forceParse
* and to test whether these options are set, use
* (if options.forceParse ... if)
*)
(# forceParse: (# enter option[1] exit option[1] #);
option: (* Private *) [10] @boolean
#);
astInterfaceNotification:
notification
(# m: ^text
enter m[]
...
#);
astInterfaceException: exception
(# m: ^text
enter m[]
...
#);
astInterfaceError:< astInterfaceException;
protect:
(* This operation is used to protect a MPS operation (or
* sequence of MPS operations agains the dynamically generated
* MPS exceptions.
*)
(# astOverflow:< astInterfaceException;
startingParsing:< (# do INNER #);
fragmentNotExisting:< astInterfaceException
(# do true->continue; INNER #);
grammarNotFound:< astInterfaceException;
badFormat:< astInterfaceException;
parseErrors:< astInterfaceException;
fatalParseError:< astInterfaceException
(# errNo: @integer enter errNo do INNER #);
doubleFormDeclaration:< astInterfaceException;
readAccessError:< astInterfaceException;
writeAccessError:< astInterfaceException;
writeAccessOnLstFileError:< astInterfaceException;
EOSError:< astInterfaceException;
noSuchFileError:< astInterfaceException;
fileExistsError:< astInterfaceException;
noSpaceLeftError:< astInterfaceException;
otherFileError:< astInterfaceException;
protectCatcher: @handler (* Private *)
(# ... #)
...
#);
astLevelInit:
(#
do ...
#);
(********** PRIVATE PART *********************)
private: @...;
parseErrorsLst: ^text; (* if during, the last parsing, there was
* parse errors, and no '.lst' file could
* be written, then this will contain the
* information otherwise found in the
* '.lst' file
*)
(* referenceGenerator: {* Private *}
* (# as: ^ast do INNER exit as[] #);
* genUnExpanded: {* Private *} @referenceGenerator
* (# do &unExpanded[]->as[] #);
* genOptional: {* Private *} @referenceGenerator
* (# do &optional[]->as[] #);
*
*)
offset: @
(* Private: the following constants are private constants to ast, which
* tells where in array A relative from 'index' different information
* can be found
*)
(# attribute: (# exit 2 #);
slotUsage: (# exit 2 #);
slotAttribute: (# exit 3 #);
commentType: (# exit 2 #);
sizePerNode:
(* tells how many entries in A is needed per node (not including
* extra attributes)
*) (# exit 2 #);
sizePerUnExpanded: (# exit 2 #);
sizePerNameAppl: (# exit 2 #);
sizePerNameDecl: (* must be equal to sizePerNameAppl *)
(# exit 2 #);
sizePerString: (# exit 2 #);
sizePerConst: (# exit 4 #);
sizePerComment: (# exit 4 #);
sizePerSlotDesc: (# exit 12 #);
#);
groupBlackNumber: (* Private *)
(* magic number. To be used to recognize group-files *)
(# exit 131453937 #);
errorNumbers: @ (* Private *)
(# noReadAccess: (# exit 1 #);
noWriteAccess: (# exit 2 #);
notExisting: (# exit 3 #);
badFormat: (# exit 4 #);
parseErrors: (# exit 5 #);
grammarNotFound: (# exit 6 #);
arrayTooBig: (# exit 7 #);
noSpaceLeft: (# exit 8 #);
writeAccessOnLstFileError: (# exit 9 #);
doubleFormDeclaration: (# exit 10 #);
EOSError: (# exit 14 #);
noSuchFile: (# exit 15 #);
fileExists: (# exit 16 #);
otherFileError: (# exit 18 #);
fatalParseError:
(* The error numbers between 101 and 199 are exclusively allocated
* for BOBS fatal parse error numbers. The original BOBS error
* number is this (no-100):
*) (# no: @integer enter no exit (100 < no) and (no < 200) #);
#);
notificationNumbers: @ (* Private *)
(# startingParsing: (# exit 201 #);
noParserAvailable: (# exit 202 #)
#);
handler: (* Private *)
(# no: @integer; msg: ^text; oldCatcher: ^handler enter (no,msg[]) do INNER #);
theCatcher: ^handler (* Private *) ;
maxdepth: (* Private: maximal elements in a stack *) (# exit 50 #);
stak: (* Private *)
(# stakOverflowException: astInterfaceException
(# do INNER ; 'error: stack overrun'->msg.putline #);
a: [maxdepth] @integer;
topindex: @integer;
init: (# do 0->topindex #);
push:
(# e: @integer
enter e
do (if topIndex=maxDepth then stakOverflowException if);
e->a[topindex+1->topindex]
#);
pop:
(# e: @integer;
do a[topindex]->e; topindex-1->topIndex;
exit e
#);
empty: (# exit (topindex = 0) #);
#);
(* The following category defines some constants used as values for super
* attributes in metagrammar-ast's
*)
super: @ (* Private *)
(# undefined: (# exit - 10 #);
cons: (# exit - 11 #);
list: (# exit 99999 #)
#);
tracer: (* Private *)
(# traceNo: @integer; dmp: ^stream
enter traceNo
...
#);
repS: (* Private *) ^repetitionStream;
doRealOpen:
(* Private: if this boolean is false, unpack of fragments will only
* read in part of the fragment description. Should only be used by the
* BETA compiler
*) @boolean;
useModificationStatus: (* Private *) @boolean;
do astLevelInit; INNER ;
#);
containerList: list
(* Private: Empty specialization of the list pattern defined in the
* containers library. It is only defined to circumvent name-clash between
* the list pattern defined in containers, and the list pattern defined here
* in astInterface.
*) (# #);
a2sInterface: (# #)
| 13.1 Astlevel Interface | © 1991-2002 Mjølner Informatics |
[Modified: Thursday October 19th 2000 at 11:53]
|