13.1 Astlevel Interface

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' #);
     Visitor:
       (* super pattern for Visitor design pattern  *)
       (# do INNER #);
     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>>;
          astVisitor:< visitor;
          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
            #);
          isSlot: (* moved from unxExpanded: is defined for any AST *) 
            (# b: @boolean
            enter (#  enter b do (b,0,1)->frag.a[index].%PutBits #)
            exit (0,1)->frag.a[index].%GetBits->b
            #);
          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
               #)
            #);
          accept:<
            (* acceptor for Visitor design pattern *)
            (# V: ^AstVisitor
            enter V[]
            do INNER
            #);
          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
            #);
          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;
               form:
                 (#
                 exit f[]
                 #);
               formname:
                 (#
                 exit name[]
                 #);
               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;
          a_range: @
            (* used when using ref2ref for allocation *)
            integerValue(# do (if a.range>value then a.range->value if) #);
          curtop: (* Private: current heapTop in the array a *) @integer;
          l: (* Private *) [initialLength] @integer;
          l_range: @
            (* used when using ref2ref for allocation *)
            integerValue(# do (if l.range>value then l.range->value if) #);
          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>>;
          treeLevelVisitor:< Visitor;
          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-2004 Mjølner Informatics
[Modified: Monday March 22nd 2004 at 8:53]