00001 /*----------------------------------------------------------------------------*/
00002 /*                                                                            */
00003 /*   Copyright (c) 2004-2009 William  Data  Systems Ltd. and Geoff Stevens.   */
00004 /*   All rights reserved.                                                     */
00005 /*                                                                            */
00006 /*   This program and the  accompanying  materials are made available under   */
00007 /*   the terms of the  Common  Public  License  v1.0 which accompanies this   */
00008 /*   distribution. A  copy  is  also  available  at  the following address:   */
00009 /*   http://www.opensource.org/licenses/cpl1.0.php                            */
00010 /*                                                                            */
00011 /*   Redistribution and use in  source  and  binary  forms, with or without   */
00012 /*   modification, are  permitted  provided  that  the following conditions   */
00013 /*   are met:                                                                 */
00014 /*                                                                            */
00015 /*   Redistributions  of  source  code  must  retain  the  above  copyright   */
00016 /*   notice, this list of conditions and the following disclaimer.            */
00017 /*                                                                            */
00018 /*   Redistributions in  binary  form  must  reproduce  the above copyright   */
00019 /*   notice, this list of  conditions  and  the following disclaimer in the   */
00020 /*   documentation and/or other materials provided with the distribution.     */
00021 /*                                                                            */
00022 /*   Neither the name or trademarks  of  William Data Systems nor the names   */
00023 /*   of its  contributors  may  be  used  to  endorse  or  promote products   */
00024 /*   derived from this software without specific prior written permission.    */
00025 /*                                                                            */
00026 /*   DISCLAIMER                                                               */
00027 /*                                                                            */
00028 /*   THIS SOFTWARE IS PROVIDED  BY  THE  COPYRIGHT HOLDERS AND CONTRIBUTORS   */
00029 /*   "AS IS" AND  ANY  EXPRESS  OR  IMPLIED  WARRANTIES, INCLUDING, BUT NOT   */
00030 /*   LIMITED TO, THE IMPLIED WARRANTIES  OF MERCHANTABILITY AND FITNESS FOR   */
00031 /*   A PARTICULAR PURPOSE ARE DISCLAIMED.  IN  NO EVENT SHALL THE COPYRIGHT   */
00032 /*   OWNER OR CONTRIBUTORS BE LIABLE  FOR ANY DIRECT, INDIRECT, INCIDENTAL,   */
00033 /*   SPECIAL,  EXEMPLARY,  OR  CONSEQUENTIAL  DAMAGES  (INCLUDING,  BUT NOT   */
00034 /*   LIMITED TO, PROCUREMENT OF SUBSTITUTE  GOODS OR SERVICES; LOSS OF USE,   */
00035 /*   DATA, OR PROFITS; OR BUSINESS  INTERRUPTION) HOWEVER CAUSED AND ON ANY   */
00036 /*   THEORY OF LIABILITY, WHETHER  IN  CONTRACT,  STRICT LIABILITY, OR TORT   */
00037 /*   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN  ANY WAY OUT OF THE USE   */
00038 /*   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.     */
00039 /*                                                                            */
00040 /*----------------------------------------------------------------------------*/
00041 --
00042 -- Parse and represent a Rexx program
00043 --
00044 -- The source program is parsed into comments, quoted
00045 -- strings and clauses. Quoted strings are necessary to
00046 -- complete parsing into clauses, since lineend (;) chars
00047 -- may appear in a quoted string
00048 --
00049 -- Clauses are then built back up into features, which
00050 -- correspond to the procedures, classes, methods, etc.
00051 -- in the program. Features consist of an undifferentiated
00052 -- list of one or more clauses. Further interpretation
00053 -- is left to other code.
00054 --
00055 -- Block comments are merged together when contiguous,
00056 -- and a list is build of code features and block comments
00057 -- ordered by start line
00058 --
00059 -- The results of the parse appear as lists of filechunks
00060 -- which the user can traverse and render as source,
00061 -- either code-only, comments-only or code and comments
00062 -- (vanilla source)
00063 --
00064 -- A Rexx program consists of a top (or entry) procedure
00065 -- and zero or more labels and procedures. If it's an OORexx
00066 -- program it may have requires clauses, classes, methods
00067 -- or routines
00068 --
00069 -- At the first sign of OORexx features (use of the twiddle,
00070 -- or OORexx directives) the procedural flag is set to .false
00071 --
00072 -- Since the lists are public, the user can do anything at
00073 -- all with them. Convenience methods are provided in the
00074 -- public method interface as an aid to navigation.
00075 --
00076 -- In general, the features and codefeatures lists are
00077 -- likely to be the most useful, followed by the clauses
00078 -- list
00079 --
00080  
00081 -- the rexxprogram class
00082 ::CLASS rexxprogram PUBLIC
00083  
00084 ::ATTRIBUTE src            -- queue of the whole source
00085 ::ATTRIBUTE cleansrc       -- queue of source minus comments
00086  
00087  
00088 ::ATTRIBUTE comments       -- queue of filechunks of comments (line and block)
00089 ::ATTRIBUTE blockcomments  -- queue of filechunks of block comments
00090 ::ATTRIBUTE linecomments   -- queue of filechunks of line comments
00091 ::ATTRIBUTE quotes         -- queue of filechunks of quoted strings
00092 ::ATTRIBUTE clauses        -- queue of filechunks of all clauses
00093 ::ATTRIBUTE labels         -- queue of filechunks of labels
00094 ::ATTRIBUTE procedures     -- queue of filechunks of procedures
00095 ::ATTRIBUTE requires       -- queue of filechunks of requires
00096 ::ATTRIBUTE classes        -- queue of filechunks of classes
00097 ::ATTRIBUTE methods        -- queue of filechunks of methods
00098 ::ATTRIBUTE routines       -- queue of filechunks of routines
00099 ::ATTRIBUTE roptions       -- queue of filechunks of options
00100 ::ATTRIBUTE rconstants     -- queue of filechunks of constants
00101 ::ATTRIBUTE features       -- queue of filechunks of all features (code and block comments)
00102 ::ATTRIBUTE codefeatures   -- queue of filechunks of code features (no comments)
00103 ::ATTRIBUTE mixedclauses   -- queue of filechunks of all clauses, including features
00104  
00105 ::ATTRIBUTE procedural     -- boolean when true the program has no oo features
00106 ::ATTRIBUTE hashbang       -- string Unix magic string or ''
00107  
00108 ::ATTRIBUTE quotemap       -- relation map to quotes by line number
00109 ::ATTRIBUTE clausemap      -- relation map to clauses by line number
00110 ::ATTRIBUTE commentmap     -- relation map to comments by line number
00111 ::ATTRIBUTE codefeaturemap -- relation map to code features by line number
00112  
00113 ::ATTRIBUTE user           -- user field: any use by client
00114  
00115 -- parse the rexx program
00116 -- @param programname - path to the program source
00117 ::METHOD init
00118   use arg programname
00119   s = .stream~new(programname)
00120   if s~query('EXISTS') = ''
00121     then do
00122            s~close
00123            raise SYNTAX 93 ARRAY(programname 'does not exist')
00124          end
00125  
00126   self~src = s~arrayin
00127   s~close
00128  
00129   -- init lists
00130   self~cleansrc = .queue~new      -- built by parsesource
00131   self~comments = .queue~new      -- built by parsesource
00132   self~quotes = .queue~new        -- built by parsesource
00133  
00134   self~blockcomments = .queue~new
00135   self~linecomments = .queue~new
00136   self~clauses = .queue~new       
00137  
00138   self~features = .queue~new
00139   self~codefeatures = .queue~new
00140   self~mixedclauses = .queue~new
00141  
00142   self~labels = .queue~new
00143   self~procedures = .queue~new
00144   self~requires = .queue~new
00145   self~classes = .queue~new
00146   self~methods = .queue~new
00147   self~routines = .queue~new
00148   self~roptions = .queue~new
00149   self~rconstants = .queue~new
00150  
00151   self~codefeaturemap = .relation~new
00152  
00153   -- procedural by default
00154   self~procedural = .true
00155   self~hashbang = ''
00156  
00157   -- parse the source into comments, code, and quotes within code
00158   self~parsesource
00159  
00160   -- defective source or non rexx text may cause anomalies
00161   self~sanity(self~comments)
00162   self~sanity(self~quotes)
00163  
00164   -- map quotes so we can detect real ';' clause ends
00165   self~mapquotes
00166  
00167   -- delimit clauses in the code
00168   self~delimitclauses
00169  
00170   -- could be a doc only program
00171   if self~clauses~items = 0
00172     then return
00173  
00174   -- map the features in the program
00175   -- find the starts and ends of code features
00176   self~getcodefeatures
00177  
00178   -- distinguish block and line comments
00179  
00180   self~sortcomments
00181  
00182   -- merge codefeatures and block comments into features
00183  
00184   self~mergefeatures
00185  
00186   -- set up class-contained methods
00187   do i over self~classes
00188     meths = self~getcontained(i)
00189     do m over meths
00190       if m~objectname = 'METH' | m~objectname = 'ATTR' | m~objectname = 'CONS'
00191         then m~ownerclass = i
00192     end
00193   end
00194   return
00195  
00196 -- ensure chunks make approximate sense
00197 -- @param chunks - array of chunks to review and fix up
00198 -- A list of chunks is scanned and any zero values are
00199 -- set to defaults
00200 ::METHOD sanity PRIVATE
00201   use arg chunks
00202   do i over chunks
00203     if i~startline = 0
00204       then i~startline = 1
00205     if i~startcol = 0
00206       then i~startcol = 1
00207     if i~endline = 0
00208       then i~endline = self~src~items
00209     if i~endcol = 0
00210       then i~endcol = self~src[self~src~items]~length~max(1)
00211   end
00212  
00213 -- parse the source into comments, quotes and code
00214 -- precondition: none
00215 ::METHOD parsesource PRIVATE
00216   expose inblock inquote inline quotechar qblock
00217  
00218   inblock = .false     -- in a block comment when true
00219   blockentry = .false  -- entering a block comment when true
00220   blockexit = .false   -- exiting a block comment when true
00221   blockdepth = 0       -- depth of block nesting
00222  
00223   inline = .false      -- in a line comment when true
00224   lineentry = .false   -- entering a line comment when true
00225  
00226   inquote = .false     -- in a non-comment quoted string when true
00227   quotechar = ''       -- current quoting character
00228  
00229   lineno = 0           -- current line number
00230   colno = 0            -- current quoting number
00231   self~commentmap = .relation~new -- from line number to comment
00232  
00233   do line over self~src
00234  
00235     lineno = lineno + 1
00236  
00237 --    if lineno = 219 then trace ?i
00238  
00239     colno = 1
00240  
00241     inline = .false -- any previous line comment is over
00242  
00243     -- get first character 
00244     parse var line 1 c 2 line
00245     if inblock
00246       then cleanline = ' '
00247       else do
00248              cleanline = c
00249              self~quotestate(c, lineno, colno)
00250            end
00251  
00252  
00253     chars = line~length
00254     do chars
00255       prev = c
00256       parse var line 1 c 2 line
00257       colno = colno + 1
00258  
00259       -- analyze where we are
00260  
00261       -- set the quote state
00262       self~quotestate(c, lineno, colno)
00263  
00264       -- set the comment state
00265       select
00266         /* */
00267         when \inline & \inquote & inblock & prev||c = '*/'
00268           then do
00269                  blockdepth = blockdepth - 1
00270                  if blockdepth = 0
00271                    then do
00272                           blockexit = .true
00273                           bcomment~endline = lineno
00274                           bcomment~endcol = colno
00275                         end
00276                end
00277         /* */
00278         when \inline & \inquote & prev||c = '/*'
00279         /* */
00280           then do
00281                  blockdepth = blockdepth + 1
00282                  if blockdepth = 1
00283                    then blockentry = .true
00284                end
00285         /* */
00286         when \inline & \inquote & \inblock & prev||c = '--'
00287           then do
00288                  lineentry = .true
00289                end
00290         /* */
00291         otherwise nop
00292       end
00293  
00294       -- now decide what to do
00295       select
00296         when blockentry
00297           then do
00298                  -- delete previous char from clean
00299                  cleanline = cleanline~left(cleanline~length-1)||' '
00300                  blockentry = .false
00301                  inblock = .true
00302                  bcomment = .comment~new(lineno, colno-1, 0, 0)
00303                end
00304         when blockexit
00305           then do
00306                  blockexit = .false
00307                  inblock = .false
00308                  bcomment~endline = lineno
00309                  bcomment~endcol = colno
00310                  self~comments~queue(bcomment)
00311                  self~commentmap[bcomment~startline] = bcomment
00312                  c = ' '
00313                end
00314         when lineentry
00315           then do
00316                  -- delete previous char from clean
00317                  cleanline = cleanline~left(cleanline~length-1)||' '
00318                  lineentry = .false
00319                  inline = .true
00320                  lcomment = .comment~new(lineno, colno-1, lineno, chars+1)
00321                  self~comments~queue(lcomment)
00322                  self~commentmap[lcomment~startline] = lcomment
00323                end
00324         otherwise nop
00325       end
00326  
00327       if inblock | inline
00328         then cleanline = cleanline||' '
00329         else cleanline = cleanline||c
00330  
00331     end
00332  
00333     self~cleansrc~queue(cleanline)
00334  
00335   end
00336  
00337 -- subroutine to set quote state
00338 ::METHOD quotestate PRIVATE
00339   expose inblock inquote inline quotechar qblock
00340   use arg c, lineno, colno
00341  
00342   select
00343     when \inblock & inquote & \inline & c = quotechar
00344       then do
00345              inquote = .false
00346              quotechar = ''
00347              qblock~endline = lineno
00348              qblock~endcol = colno
00349            end
00350     when \inblock & \inquote & \inline & c = '"'
00351       then do
00352              inquote = .true
00353              quotechar = '"'
00354              qblock = .quoted~new(lineno, colno, 0, 0)
00355              self~quotes~queue(qblock)
00356            end
00357     when \inblock & \inquote & \inline & c = "'"
00358       then do
00359              inquote = .true
00360              quotechar = "'"
00361              qblock = .quoted~new(lineno, colno, 0, 0)
00362              self~quotes~queue(qblock)
00363            end
00364     /* */
00365     otherwise nop
00366   end
00367   return
00368  
00369 -- map quotes so we can detect real ';' clause ends
00370 -- precondition: parsesource has run
00371 ::METHOD mapquotes PRIVATE
00372   self~quotemap = .relation~new
00373   do i over self~quotes
00374     sl = i~startline
00375     el = i~endline
00376     if el > sl
00377      then do j = sl to el
00378             self~quotemap~put(i, j)
00379           end
00380      else self~quotemap~put(i, sl)
00381   end
00382  
00383 -- delimit clauses into the clause list
00384 -- precondition: mapquotes has run
00385 -- now we can tell for any character position
00386 -- whether it's in a quote or not
00387 ::METHOD delimitclauses PRIVATE
00388  
00389   self~clausemap = .relation~new -- map to speed up finding whether a line has a clause
00390   self~clauses = .queue~new
00391  
00392   lines = self~cleansrc~items
00393   continue = .false
00394  
00395   -- we commence by delimiting into rough, or sugared
00396   -- clauses
00397   -- any evidence of ooRexx is noted
00398   -- continued clauses are assembled over lines
00399   -- multiple explicit clauses on a line are delimited
00400   roughclauses = .queue~new
00401  
00402   do lineno = 1 to lines
00403     line = self~cleansrc[lineno]
00404     if line~words = 0
00405       then iterate
00406  
00407     if lineno = 1 & line~word(1)~left(2) = '#!'
00408       then do
00409             self~hashbang = line
00410             iterate
00411            end
00412  
00413     if \continue
00414       then do
00415              pfword = line~wordindex(1)
00416              cl = .clause~new(lineno, pfword, 0, 0)
00417              roughclauses~queue(cl)
00418            end
00419  
00420     -- look for twiddles on the line
00421     tpos = line~pos('~', 1)
00422     do while tpos > 0
00423       if \self~isinquote(lineno, tpos)
00424         then do
00425                self~procedural = .false
00426                leave
00427              end
00428       tpos = line~pos('~', tpos+1)
00429     end
00430  
00431     -- delimit multiple explicit clauses on a line
00432     spos = line~pos(';',1)
00433     do while spos > 0
00434       if \self~isinquote(lineno, spos)
00435         then do
00436                cl~endline = lineno
00437                cl~endcol = spos-1
00438                if spos < line~length
00439                  then do
00440                         cl = .clause~new(lineno, spos+1, 0, 0)
00441                         roughclauses~queue(cl)
00442                       end
00443              end
00444       spos = line~pos(';', spos+1)
00445     end
00446     -- check for continuations
00447     if line~word(line~words)~right(1) = ','
00448       then do
00449              continue = .true
00450            end
00451       else do
00452              -- finish clause at line end
00453              continue = .false
00454              cl~endline = lineno
00455              plastword = line~wordindex(line~words)
00456              cl~endcol = plastword + line~word(line~words)~length - 1
00457            end
00458   end
00459  
00460   -- clauses are now roughly broken down, we need to remove syntactic sugar
00461   -- and set up the map from line number to clauses
00462   do c over roughclauses
00463     sour = self~unsugar(c)
00464     do s over sour
00465       self~clauses~queue(s)
00466       self~clausemap~put(s, s~startline)
00467     end
00468   end
00469  
00470 -- deal with run-on clauses for IF and WHEN etc.
00471 -- Rexx has some syntactic sugar to let people write things like
00472 --
00473 --       if a=1 then do
00474 --         call a1
00475 --       end
00476 --
00477 -- where there are implied semicolons before and after the
00478 -- 'then' keyword
00479 --
00480 -- @param c - a possibly sugared clause
00481 -- @return a queue of one or more clauses derived from c
00482 ::METHOD unsugar PRIVATE
00483   use arg c
00484   ret = .queue~new
00485  
00486   src = self~getnoppedsource(c)
00487  
00488   -- quick check for interesting
00489   parse upper value src[1] with w1 .
00490   if w1 <> 'IF',
00491    & w1 <> 'WHEN',
00492    & w1 <> 'ELSE',
00493    & w1 <> 'OTHERWISE',
00494    & w1 <> 'THEN'
00495     then do
00496            -- not interesting
00497            ret~queue(c)
00498            return ret
00499          end
00500  
00501   -- quick check for enough words
00502   if src~items = 1 & src[1]~words < 2
00503      then do
00504            -- not interesting
00505            ret~queue(c)
00506            return ret
00507          end
00508  
00509   -- get the full clause
00510   fc = .flatclause~new(c, src)
00511   totwords = fc~flat~words
00512  
00513   upcase = fc~flat~translate
00514  
00515   -- locate sugared words
00516   tword = upcase~wordpos('THEN')
00517   dword = upcase~wordpos('DO')
00518   oword = upcase~wordpos('OTHERWISE')
00519  
00520   -- quick check for no sugar
00521   if tword = 0 & dword = 0 & oword = 0
00522      then do
00523            -- no interesting words
00524            ret~queue(c)
00525            return ret
00526          end
00527  
00528   -- the full nine yards of removing sugar by splitting
00529   -- sugared clause into two or more unsugared clauses
00530  
00531   -- get char indices of words
00532   if tword > 0
00533     then tpos = upcase~wordindex(tword)
00534     else tpos = 0
00535  
00536   if dword > 0
00537     then dpos = upcase~wordindex(dword)
00538     else dpos = 0
00539  
00540   if oword > 0
00541     then opos = upcase~wordindex(oword)
00542     else opos = 0
00543  
00544   -- handle consequences by splitting out compound clauses
00545   -- into atomic clauses
00546   -- an atomic clause is anything that you could put a semicolon
00547   -- at the end of without changing the syntactic correctness of
00548   -- the program
00549   select
00550     when tpos > 0 & dpos > 0 & totwords = 2 -- then do
00551       then do
00552              -- split at do
00553              ret = self~splitclause(c, fc, dpos)
00554            end
00555     when opos > 0 & dpos > 0 & totwords = 2 -- otherwise do
00556       then do
00557              -- split at do
00558              ret = self~splitclause(c, fc, dpos)
00559            end
00560     when tpos > 0 & dpos > 0 -- ... then do
00561       then do
00562              -- split at then and do
00563              ret = self~splitclause(c, fc, tpos dpos)
00564            end
00565     when opos > 0 & dpos > 0 -- ... otherwise do
00566       then do
00567              -- split at otherwise and do
00568              ret = self~splitclause(c, fc, opos dpos)
00569            end
00570     when dpos > 0 -- .. do
00571       then do
00572              -- split at do
00573              ret = self~splitclause(c, fc, dpos)
00574            end
00575     when tpos > 0
00576       then do
00577              -- then with no do
00578              select
00579                when tword = totwords -- then is last word
00580                  then do
00581                         -- split at then
00582                         ret = self~splitclause(c, fc, tpos)
00583                       end
00584                when tword = 1 -- then is first word
00585                  then do
00586                         -- split after then
00587                         ret = self~splitclause(c, fc, tpos+'THEN'~length+1)
00588                       end
00589                otherwise do -- then in the middle
00590                            -- split before and after then
00591                            ret = self~splitclause(c, fc, tpos tpos+'THEN'~length+1)
00592                          end
00593              end
00594            end
00595     when opos > 0
00596       then do
00597              -- otherwise with no do
00598              select
00599                when oword = totwords -- otherwise is last word
00600                  then do
00601                         -- split at otherwise
00602                         ret = self~splitclause(c, fc, opos)
00603                       end
00604                when oword = 1 -- otherwise is first word
00605                  then do
00606                         -- split after otherwise
00607                         ret = self~splitclause(c, fc, opos+'OTHERWISE'~length+1)
00608                       end
00609                otherwise do -- otherwise in the middle
00610                            -- split before and after otherwise
00611                            ret = self~splitclause(c, fc, opos tpos+'OTHERWISE'~length+1)
00612                          end
00613              end
00614            end
00615     otherwise do
00616                  ret~queue(c)
00617                end
00618  
00619   end
00620   return ret
00621  
00622 -- produce a queue of cloned clauses
00623 ::METHOD splitclause PRIVATE
00624   use arg c, fc, splitpoints
00625   ret = .queue~new
00626  
00627   -- get enough clones
00628   do j = 1 to splitpoints~words + 1
00629     ret~queue(c~clone)
00630   end
00631  
00632   do j = 1 to splitpoints~words
00633     split = splitpoints~word(j)
00634     k = j + 1
00635     parse value fc~index2vector(split) with endline endcol
00636     ret[j]~endline = endline
00637     ret[j]~endcol = endcol - 1
00638     ret[k]~startline = endline
00639     ret[k]~startcol = endcol
00640   end
00641  
00642   return ret
00643  
00644 -- distinguish clauses into interesting features
00645 -- precondition: delimitclauses has run
00646 ::METHOD getcodefeatures PRIVATE
00647   -- is there an entry procedure?
00648   clause = self~clauses[1]
00649   uclause = self~getwholeclause(clause)~translate
00650   parse var uclause w1 w2 .
00651   if w1~translate \= '::REQUIRES',
00652    & w1~translate \= '::CLASS',
00653    & w1~translate \= '::ROUTINE',
00654    & w1~translate \= '::METHOD'
00655     then do
00656            -- not a valid rexx program if it starts with a procedure
00657            -- but I do this for frequently-included classic routines
00658            if w2~translate <> 'PROCEDURE'
00659              then do
00660                      -- set up the top procedure
00661                      p = .proc~new('--entry_proc',clause~startline, clause~startcol, 0, 0, 1, self)
00662                      self~procedures~queue(p)
00663                      self~codefeatures~queue(p)
00664                      self~mixedclauses~queue(p)
00665                   end
00666          end
00667  
00668   do clauseix = 1 to self~clauses~items
00669     clause = self~clauses[clauseix]
00670  
00671     mclause = self~getwholeclause(clause)
00672     uclause = mclause~translate
00673     parse var uclause w1 w2 .
00674     select
00675       when w1~right(1) = ':' | w1~right(2) = ':;'
00676         then do
00677                parse var mclause labname ':'
00678                -- label or procedure label?
00679                if w2 = 'PROCEDURE'
00680                  then do
00681                         p = .proc~new(labname, clause~startline, clause~startcol, 0, 0, clauseix, self)
00682                         self~procedures~queue(p)
00683                         self~codefeatures~queue(p)
00684                         self~mixedclauses~queue(p)
00685                       end
00686                  else do
00687                         l = .label~new(labname, clause~startline, clause~startcol, clause~endline, clause~endcol, clauseix, self)
00688                         self~labels~queue(l)
00689                         self~codefeatures~queue(l)
00690                         self~mixedclauses~queue(l)
00691                       end
00692              end
00693       when w1 = '::REQUIRES'
00694         then do
00695                parse var mclause . req
00696                r =  .requires~new(req~strip, clause~startline, clause~startcol, 0, 0, clauseix, self)
00697                self~requires~queue(r)
00698                self~codefeatures~queue(r)
00699                self~mixedclauses~queue(r)
00700                self~procedural = .false
00701              end
00702       when w1 = '::CLASS'
00703         then do
00704                parse var mclause . classname .
00705                if classname~words = 0
00706                  then iterate
00707                c = .rclass~new(classname, clause~startline, clause~startcol, 0, 0, clauseix, self)
00708                self~classes~queue(c)
00709                self~codefeatures~queue(c)
00710                self~mixedclauses~queue(c)
00711                self~procedural = .false
00712              end
00713       when w1 = '::METHOD'
00714         then do
00715                parse var mclause . methodname .
00716                if methodname~words = 0
00717                  then iterate
00718                if uclause~wordpos('ATTRIBUTE') > 0
00719                  then m =  .rattribute~new(methodname, clause~startline, clause~startcol, 0, 0, clauseix, self)
00720                  else m =  .rmethod~new(methodname, clause~startline, clause~startcol, 0, 0, clauseix, self)
00721                self~methods~queue(m)
00722                self~codefeatures~queue(m)
00723                self~mixedclauses~queue(m)
00724                self~procedural = .false
00725              end
00726       when w1 = '::ATTRIBUTE' 
00727         then do
00728                parse var mclause . methodname .
00729                if methodname~words = 0
00730                  then iterate
00731                m =  .rattribute~new(methodname, clause~startline, clause~startcol, 0, 0, clauseix, self)
00732                self~methods~queue(m)
00733                self~codefeatures~queue(m)
00734                self~mixedclauses~queue(m)
00735                self~procedural = .false
00736              end
00737       when w1 = '::CONSTANT'
00738         then do
00739                parse var mclause . varname varvalue
00740                if varname~words = 0
00741                  then iterate
00742                m =  .rconstant~new(varname, varvalue, clause~startline, clause~startcol, 0, 0, clauseix, self)
00743                self~rconstants~queue(m)
00744                self~codefeatures~queue(m)
00745                self~mixedclauses~queue(m)
00746                self~procedural = .false
00747              end
00748       when w1 = '::ROUTINE'
00749         then do
00750                parse var mclause . routinename .
00751                if routinename~words = 0
00752                  then iterate
00753                t =  .routine~new(routinename, clause~startline, clause~startcol, 0, 0, clauseix, self)
00754                self~routines~queue(t)
00755                self~codefeatures~queue(t)
00756                self~mixedclauses~queue(t)
00757                self~procedural = .false
00758              end
00759       when w1 = '::OPTIONS'
00760         then do
00761                parse var mclause . optionlist.
00762                t =  .roptions~new(optionlist~strip, clause~startline, clause~startcol, 0, 0, clauseix, self)
00763                self~roptions~queue(t)
00764                self~codefeatures~queue(t)
00765                self~mixedclauses~queue(t)
00766                self~procedural = .false
00767              end
00768       otherwise self~mixedclauses~queue(clause)
00769     end
00770   end
00771  
00772  
00773   -- determine the ends of features
00774   do j = 1 to self~codefeatures~items
00775     curfeat = self~codefeatures[j]
00776  
00777     select
00778       -- a label is terminaed by itself
00779       when curfeat~objectname = 'LABL'
00780         then do
00781                -- a label terminates itself
00782                endclause = self~clauses[curfeat~startclause]
00783              end
00784       -- a class is terminated by another class, or a routine
00785       when curfeat~objectname = 'CLAS'
00786         then do
00787                -- locate terminating feature for class
00788                nf = self~nextfeature(curfeat, 'CLAS ROUT')
00789                if nf = .nil
00790                  then endclause = self~clauses[self~clauses~last]
00791                  else endclause = self~clauses[nf~startclause-1]
00792              end
00793       -- everything else is terminated by anything except a label
00794       otherwise do
00795                   nf = self~nextfeature(curfeat, 'CLAS ROUT METH ATTR PROC REQU')
00796                   if nf = .nil
00797                     then endclause = self~clauses[self~clauses~last]
00798                     else endclause = self~clauses[nf~startclause-1]
00799  
00800                 end
00801     end
00802  
00803  
00804     curfeat~endline = endclause~endline
00805     curfeat~endcol = endclause~endcol
00806     curfeat~endclause = self~clauses~index(endclause)
00807  
00808   end
00809  
00810   -- complete details of features
00811   -- rexx attributes and routine arguments are parsed
00812   do i over self~procedures
00813      self~procsetup(i)
00814   end
00815   do i over self~requires
00816      self~requiressetup(i)
00817   end
00818   do i over self~classes
00819      self~classsetup(i)
00820   end
00821   do i over self~methods
00822      self~methodsetup(i)
00823   end
00824   do i over self~routines
00825      self~routinesetup(i)
00826   end
00827  
00828   -- map code features to line number
00829   do i over self~codefeatures
00830     self~codefeaturemap~put(i, i~startline)
00831   end
00832  
00833  
00834  
00835 -- return next interesting feature
00836 -- @param current - the current feature
00837 -- @param goodlist - object names of features we're looking for
00838 ::METHOD nextfeature 
00839   use arg current, goodlist
00840  
00841   j = self~codefeatures~index(current) + 1
00842  
00843   do j = j to self~codefeatures~items
00844     t = self~codefeatures[j]
00845     if goodlist~wordpos(t~objectname) > 0
00846       then return t
00847   end
00848   return .nil
00849  
00850 -- complete proc filechunk
00851 -- @param fc - filechunk of the proc
00852 --
00853 ::METHOD procsetup PRIVATE
00854   use arg fc
00855  
00856   -- get the source of the procedure
00857   proc = self~getclausecode(fc)
00858  
00859   if fc~rname <> '--entry_proc'
00860     then do
00861            fc~exposelist = self~getexposelist(proc)
00862          end
00863   fc~arglist = self~getarglist(proc)
00864  
00865  
00866 -- complete requires filechunk
00867 -- @param fc - filechunk of the requires
00868 --
00869 ::METHOD requiressetup PRIVATE
00870   use arg fc
00871   -- currently, no setup
00872   return
00873  
00874 -- complete class filechunk
00875 -- @param fc - filechunk of the requires
00876 ::METHOD classsetup PRIVATE
00877   use arg fc
00878  
00879   -- get the clauses in the feature
00880   clauses = self~getfeature(fc)
00881  
00882   -- get the code for the first clause
00883   definer = self~getcode(clauses[1])[1]
00884   udefiner = definer~translate
00885  
00886   ix = udefiner~wordpos('METACLASS')
00887   if ix > 0
00888     then fc~metaclass = definer~word(ix+1)
00889  
00890   ix = udefiner~wordpos('MIXINCLASS')
00891   if ix > 0
00892     then fc~mixinclass = definer~word(ix+1)
00893  
00894   ix = udefiner~wordpos('SUBCLASS')
00895   if ix > 0
00896     then fc~subclass = definer~word(ix+1)
00897  
00898   if udefiner~wordpos('PUBLIC') > 0
00899     then fc~public = .true
00900  
00901   ix = udefiner~wordpos('INHERIT')
00902   if ix > 0
00903     then fc~inherit = definer~subword(ix+1)
00904  
00905 -- complete method filechunk
00906 -- @param fc - filechunk of the method
00907 ::METHOD methodsetup PRIVATE
00908   use arg fc
00909  
00910   -- get the source of the method
00911   meth = self~getclausecode(fc)
00912  
00913   if fc~objectname = 'METH'
00914     then do
00915            -- get expose and arg lists
00916            fc~exposelist = self~getexposelist(meth)
00917            fc~arglist = self~getarglist(meth)
00918          end
00919  
00920   -- handle definition
00921   definer = meth[1]
00922   udefiner = definer~translate
00923  
00924   if udefiner~wordpos('CLASS') > 0
00925     then fc~cclass = .true
00926  
00927   if udefiner~wordpos('PRIVATE') > 0
00928     then fc~public = .false
00929  
00930   if udefiner~wordpos('ABSTRACT') > 0
00931     then fc~abstract = .true
00932  
00933   if udefiner~wordpos('PROTECTED') > 0
00934     then fc~protected = .true
00935  
00936   if udefiner~wordpos('UNGUARDED') > 0
00937     then fc~guarded = .false
00938  
00939 -- complete routine filechunk
00940 -- @param fc - filechunk of the routine
00941 ::METHOD routinesetup PRIVATE
00942   use arg fc
00943  
00944   -- get the source of the method
00945   rout = self~getclausecode(fc)
00946  
00947   -- get expose and arg lists
00948   fc~exposelist = self~getexposelist(rout)
00949   fc~arglist = self~getarglist(rout)
00950  
00951   -- handle definition
00952   definer = rout[1]
00953   udefiner = definer~translate
00954  
00955   if udefiner~wordpos('PUBLIC') > 0
00956     then fc~public = .true
00957  
00958  
00959 -- get list of exposed variables for a
00960 -- procedure, method or routine
00961 -- @param clauses - queue of clauses in the feature
00962 -- @return - string list of exposed variables
00963 ::METHOD getexposelist
00964   use arg clauses
00965  
00966   clause = clauses[1]
00967   uclause = clause~translate
00968  
00969   if uclause~word(2) = 'PROCEDURE',
00970    & uclause~word(3) = 'EXPOSE'
00971      then do
00972             return clause~subword(4)
00973           end
00974  
00975   if clauses~items > 1
00976     then do
00977            clause = clauses[2]
00978            uclause = clause~translate
00979            if uclause~word(1) = 'EXPOSE'
00980              then do
00981                     return clause~subword(2)
00982                   end
00983          end
00984  
00985   return ''
00986  
00987 -- get first use of {parse|use} arg in a feature
00988 -- in the feature
00989 -- @param clauses - queue of clauses in the feature
00990 -- @return - string list of arguments (commas removed)
00991 ::METHOD getarglist
00992   use arg clauses
00993  
00994   do clause over clauses
00995     uclause = clause~translate
00996     parse var uclause w1 w2 w3 w4 .
00997     select
00998       when w1 = 'ARG'
00999         then return clause~subword(2)~translate(' ',',')~space
01000       when w1 = 'PARSE' & w2 = 'ARG'
01001         then return clause~subword(3)~translate(' ',',')~space
01002       when w1 = 'PARSE' & w3 = 'ARG'
01003          then return clause~subword(4)~translate(' ',',')~space
01004       when w1 = 'PARSE' & w4 = 'ARG'
01005         then return clause~subword(5)~translate(' ',',')~space
01006       when w1 = 'USE' & w2 = 'ARG'
01007         then do
01008                self~procedural = .false
01009               return clause~subword(3)~translate(' ',',')~space
01010              end
01011       when w1 = 'USE' & w3 = 'ARG'
01012         then do
01013                self~procedural = .false
01014               return clause~subword(4)~translate(' ',',')~space
01015              end
01016       otherwise nop
01017     end
01018   end
01019  
01020   return ''
01021  
01022   -- -- --
01023  
01024 -- sort comments into line and block, and merge contiguous blocks
01025 --
01026 -- a block comment is any comment line or contiguous comment lines with
01027 -- no executable clause on them
01028 -- a line comment is any comment line or contiguous comment lines with
01029 -- one or more executable clauses on them
01030 ::METHOD sortcomments PRIVATE
01031   do j = 1 to self~comments~items
01032     com = self~comments[j]
01033     -- if there's a clause on the line, it's a line comment
01034     -- otherwise a block
01035 --  aclause = self~clausemap~allat(com~startline)
01036     aclause = self~safeallat(self~clausemap, com~startline)
01037     if aclause~items > 0
01038       then self~linecomments~queue(com)
01039       else do
01040              -- merge any following block comments into one
01041              endcom = com
01042              do k = j + 1 to self~comments~items
01043                next = self~comments[k]
01044                if next~startline <> endcom~endline+1,
01045                 & next~startline <> endcom~endline
01046                  then leave -- not contiguous
01047 --               zclause = self~clausemap~allat(next~startline)
01048                  zclause = self~safeallat(self~clausemap, next~startline)
01049                if zclause~items > 0
01050                  then leave -- a line comment
01051                endcom = next
01052              end
01053              nc = .comment~new(com~startline, com~startcol, endcom~endline, endcom~endcol)
01054              self~blockcomments~queue(nc)
01055              j = k - 1
01056            end
01057  
01058   end
01059  
01060 -- circumvent 4.20 beta bug
01061 -- @param r - a relation
01062 -- @param index - an index
01063 -- @return an array of zero or more items
01064 ::METHOD safeallat 
01065   use arg r, index
01066   if r~hasindex(index)
01067     then return r~allat(index)
01068   return .array~new
01069  
01070 -- merge codefeatures and block comments into features
01071 -- retaining startline order
01072 ::METHOD mergefeatures PRIVATE
01073  
01074   if self~codefeatures~items = 0
01075     then do
01076            -- copy in the comments
01077            do j = 1 to self~blockcomments~items
01078              self~features~queue(self~blockcomments[j])
01079            end
01080            return
01081          end
01082  
01083   if self~blockcomments~items = 0
01084     then do
01085            -- copy in the code
01086            do j = 1 to self~codefeatures~items
01087              self~features~queue(self~codefeatures[j])
01088            end
01089            return
01090          end
01091  
01092   -- merge
01093   cfix = 1
01094   bcix = 1
01095  
01096   code = self~codefeatures[cfix]
01097   com = self~blockcomments[bcix]
01098  
01099   do forever
01100  
01101     select
01102       when code~startline < com~startline
01103         then do
01104                self~features~queue(code)
01105                cfix = cfix + 1
01106                if cfix > self~codefeatures~items
01107                  then do
01108                         -- copy in the comments
01109                         do j = bcix to self~blockcomments~items
01110                           self~features~queue(self~blockcomments[j])
01111                         end
01112                         leave
01113                       end
01114                code = self~codefeatures[cfix]
01115              end
01116       when code~startline > com~startline
01117         then do
01118                self~features~queue(com)
01119                bcix = bcix + 1
01120                if bcix > self~blockcomments~items
01121                  then do
01122                         -- copy in the code
01123                         do j = cfix to self~codefeatures~items
01124                           self~features~queue(self~codefeatures[j])
01125                         end
01126                         leave
01127                       end
01128                com = self~blockcomments[bcix]
01129              end
01130       otherwise do
01131                   say 'logic error! code and blockcomment coincide!'
01132                   say 'code:' code~getpos 'comment' com~saypos
01133                   exit
01134                 end
01135     end
01136   end
01137  
01138  
01139 -- return all the clauses at lineno
01140 -- @param lineno - the line number for which to get clauses
01141 -- @return Queue of clauses
01142 ::METHOD getclausesat
01143   use strict arg lineno
01144 -- clauses = self~clausemap~allat(lineno)
01145   clauses = self~safeallat(self~clausemap, lineno)
01146  
01147   sorted = .queue~new
01148  
01149   -- alas the clauses come back in no defined order
01150   -- so we need to sort them
01151   do while clauses~items > 0
01152     s = clauses~supplier
01153  
01154     min = s~item
01155  
01156     do while s~available
01157       i = s~item
01158       if i~startcol < min~startcol
01159         then do
01160                min = i
01161              end
01162       s~next
01163     end
01164     sorted~queue(min)
01165     gigo = clauses~removeitem(min)
01166  end
01167  return sorted
01168  
01169 -- return all clauses in feature
01170 -- @param feature - the feature for which to get clauses
01171 -- @return Queue of clauses
01172 ::METHOD getfeature
01173   use arg feature
01174  
01175   clauses = .queue~new
01176   -- eqivalent of array~section
01177  
01178   do j = feature~startclause to  feature~endclause
01179     clauses~queue(self~clauses[j])
01180   end
01181   return clauses
01182  
01183 -- return any line comment associated with filechunk
01184 -- @param filechunk - the filechunk for which to get line comment
01185 -- @return String or .nil
01186 ::METHOD getlinecomment
01187   use arg filechunk
01188  
01189   return self~commentmap[filechunk~startline]
01190  
01191 -- get any block comment between this feature
01192 -- and the preceding feature
01193 -- @param feature - for which to find preceding block comment
01194 -- @return a comment feature or .nil if no block comment
01195 ::METHOD getprevcomment
01196   use arg feature
01197  
01198   j = self~features~index(feature)
01199   if j = 1
01200     then return .nil
01201  
01202   j = j - 1
01203   if self~features[j]~objectname <> 'COMT'
01204     then return .nil
01205  
01206   prevblock = self~features[j]
01207   if j = 1
01208     then return prevblock
01209  
01210   prevnonblock = .nil
01211   j = j - 1
01212   do j = j to 1
01213     if self~features[j]~objectname <> 'COMT'
01214       then do
01215              prevnonblock = self~features[j]
01216              leave
01217            end
01218   end
01219   if prevnonblock = .nil
01220     then return prevblock
01221   if prevnonblock~endline > prevblock~startline
01222     then return .nil
01223  
01224   return prevblock
01225  
01226  
01227  
01228 -- return a (possibly continued) clause
01229 -- as a single clause
01230 -- @param fc - filechunk of clause for which to get source
01231 -- @return String of clause
01232 ::METHOD getwholeclause
01233   use arg fc
01234   stack = self~getcode(fc)
01235   if stack~items = 1
01236     then return stack[1]~strip
01237  
01238   whole = ''
01239   do j = 1 to stack~items
01240     cont = stack[j]~strip
01241     if j <> stack~items & cont~length > 1
01242      then whole = whole cont~left(cont~length-1)
01243      else whole = whole cont
01244   end
01245   return whole
01246  
01247 -- return source corresponding to filechunk
01248 -- with no comments, but not parsed into clauses
01249 -- @param fc - filechunk for which to get code
01250 -- @return Queue of source
01251 ::METHOD getcode
01252   use arg fc
01253   code = .queue~new
01254  
01255   do j = fc~startline to fc~endline
01256     line = self~cleansrc[j]
01257     select
01258       when j = fc~startline & j = fc~endline
01259         then clause = line~substr(fc~startcol, fc~endcol-fc~startcol+1)
01260       when j = fc~startline
01261         then clause = line~substr(fc~startcol)
01262       when j = fc~endline
01263         then clause = line~substr(1, fc~endcol)~strip
01264       otherwise clause = line~strip
01265     end
01266     code~queue(clause)
01267   end
01268   return code
01269  
01270 -- return clause source corresponding to filechunk
01271 -- each clause in a separate item
01272 -- @param fc - filechunk for which to get code
01273 -- @return Queue of source
01274 ::METHOD getclausecode
01275   use arg fc
01276  
01277   clausecode = .queue~new
01278   clauses = self~getfeature(fc)
01279   do clause over clauses
01280     clausecode~queue(self~getcode(clause)[1])
01281   end
01282  
01283   return clausecode
01284  
01285 -- return source corresponding to filechunk
01286 -- including comments
01287 -- @param fc - filechunk for which to get code
01288 -- @return Queue of source
01289 ::METHOD getsource
01290   use arg fc
01291   clauses = .queue~new
01292  
01293   do j = fc~startline to fc~endline
01294     line = self~src[j]
01295     select
01296       when j = fc~startline & j = fc~endline
01297         then clause = line~substr(fc~startcol, fc~endcol-fc~startcol+1)
01298       when j = fc~startline
01299         then clause = line~substr(fc~startcol)
01300       when j = fc~endline
01301         then clause = line~substr(1, fc~endcol)
01302       otherwise clause = line
01303     end
01304     clauses~queue(clause)
01305   end
01306   return clauses
01307  
01308 -- return source of a filechunk with literals set to 'o'
01309 -- including comments
01310 -- @param fc - filechunk for which to get literal nopped code
01311 -- @return Queue of source
01312 ::METHOD getnoppedsource
01313   use arg fc
01314   clauses = .queue~new
01315  
01316   do j = fc~startline to fc~endline
01317     line = self~src[j]
01318     -- get quotes
01319 --    quoted = self~quotemap~allat(j)
01320     quoted = self~safeallat(self~quotemap, j)
01321     -- fix quotes
01322     do quote over quoted
01323       litlen = quote~endcol - quote~startcol - 1
01324       line = line~overlay('o'~copies(litlen), quote~startcol+1, litlen)
01325     end
01326     -- extract source
01327     select
01328       when j = fc~startline & j = fc~endline
01329         then clause = line~substr(fc~startcol, fc~endcol-fc~startcol+1)
01330       when j = fc~startline
01331         then clause = line~substr(fc~startcol)
01332       when j = fc~endline
01333         then clause = line~substr(1, fc~endcol)
01334       otherwise clause = line
01335     end
01336     clauses~queue(clause)
01337   end
01338   return clauses
01339  
01340 -- returns Boolean indicating whether character position is
01341 -- in a quoted string
01342 -- @param line - line number of character
01343 -- @param col - column number of character
01344 -- @return .true - character is in a quoted string
01345 -- @return .false - character is not in a quoted string
01346 ::METHOD isinquote PRIVATE
01347   use arg line, col
01348   if \self~quotemap~hasindex(line)
01349     then return .false
01350  
01351 --  quoted = self~quotemap~allat(line)
01352   quoted = self~safeallat(self~quotemap, line)
01353  
01354   do i over quoted
01355     if col < i~endcol & col > i~startcol
01356       then return .true
01357   end
01358   return .false
01359  
01360 ::METHOD iscomment PRIVATE
01361   use arg line, col
01362 --  commented = self~commentemap~allat(line)
01363   commented = self~safeallat(self~commentemap, line)
01364  
01365   do i over commented
01366     if col < i~endcol & col > i~startcol
01367       then return .true
01368   end
01369   return .false
01370  
01371 -- return contained features
01372 -- @param feature - filechunk of feature
01373 -- @return Queue - filechunks of contained features
01374 ::METHOD getcontained
01375   use arg feature
01376  
01377   j = self~features~index(feature)
01378   if j = .nil
01379     then raise SYNTAX 93 ARRAY('getcontained for unknown feature')
01380  
01381   contained = .queue~new
01382  
01383   do j = j+1 to self~features~items
01384     cfeat = self~features[j]
01385     if cfeat~startline <= feature~endline
01386       then do
01387              if cfeat~startline = feature~startline,
01388                & cfeat~endcol < feature~startcol
01389                then iterate
01390  
01391              if cfeat~startline = feature~endline,
01392                & cfeat~startcol > feature~endcol
01393                then iterate
01394  
01395              contained~queue(cfeat)
01396              iterate
01397            end
01398     leave
01399   end
01400   return contained
01401  
01402  
01403 -- abstract class for an extent of the source file
01404 --
01405 -- filechunks may appear mixed up in lists
01406 -- they are distinguished by their ~objectname
01407 -- supplied by the concrete specialization
01408 --
01409 ::CLASS filechunk
01410 ::METHOD startline ATTRIBUTE  -- first line of chunk
01411 ::METHOD startcol ATTRIBUTE   -- first column of chunk
01412 ::METHOD endline ATTRIBUTE    -- last line of chunk
01413 ::METHOD endcol ATTRIBUTE     -- last column of chunk
01414 ::ATTRIBUTE user           -- user field: any use by client
01415 ::METHOD init
01416   use arg startline, startcol, endline, endcol
01417   self~startline = startline
01418   self~startcol = startcol
01419   self~endline = endline
01420   self~endcol = endcol
01421   self~init:super()
01422  
01423 -- return position information as a string
01424 ::METHOD getpos
01425   return self~startline':'self~startcol','self~endline':'self~endcol
01426  
01427 -- describe the object as a string
01428 ::METHOD makestring
01429   return self~objectname self~getpos 
01430  
01431 -- return whether or not this filechunk contains another
01432 -- @param contained - filechunk which may be contained by this
01433 -- @return .true - this filechunk contains contained
01434 -- @return .false - this filechunk does not contain contained
01435 ::METHOD contains
01436   use arg contained
01437  
01438   if contained~startline >= self~startline,
01439    & contained~endline <= self~endline
01440     then do
01441            if contained~startline = self~startline,
01442              & contained~endcol < self~startcol
01443              then return .false
01444  
01445            if contained~startline = self~endline,
01446              & contained~startcol > self~endcol
01447              then return .false
01448  
01449            return .true
01450          end
01451  
01452   return .false
01453  
01454 -- specialization for a comment
01455 -- a comment is a filechunk with the objectname 'COMT'
01456 -- it represents a rexx line or block comment
01457 -- a line comment is a comment on a line that has
01458 -- an executable clause on it
01459 -- a block comment is a comment on one or more
01460 -- contiguous lines with no executable clauses on them
01461 ::CLASS comment SUBCLASS filechunk
01462 ::METHOD init
01463   use arg startline, startcol, endline, endcol
01464   self~init:super(startline, startcol, endline, endcol)
01465   self~objectname = 'COMT'
01466  
01467 -- specialisation for a clause
01468 -- a clause is a filechunk with the objectname 'CLAU'
01469 -- it represents a single Rexx executable clause
01470 ::CLASS clause PUBLIC SUBCLASS filechunk
01471 ::METHOD init
01472   use arg startline, startcol, endline, endcol
01473   self~init:super(startline, startcol, endline, endcol)
01474   self~objectname = 'CLAU'
01475  
01476 ::METHOD clone
01477   return .clause~new(self~startline, self~startcol, self~endline, self~endcol)
01478  
01479 -- specialization for a quoted string
01480 -- a quoted is a filechunk with the objectname 'QUOT'
01481 -- it represents a quoted string in an executable clause
01482 ::CLASS quoted SUBCLASS filechunk
01483 ::METHOD init
01484   use arg startline, startcol, endline, endcol
01485   self~init:super(startline, startcol, endline, endcol)
01486   self~objectname = 'QUOT'
01487  
01488 -- abstract class for features
01489 --
01490 -- a feature is a filechunk with a rexx name, and
01491 -- one or more clauses that comprise the feature
01492 --
01493 -- specializations of feature may appear mixed up
01494 -- in lists. Distinguish them by their ~objectname
01495 --
01496 ::CLASS feature SUBCLASS filechunk inherit Comparable
01497 ::ATTRIBUTE rname        -- rexx name of feature
01498 ::ATTRIBUTE startclause  -- first clause in feature
01499 ::ATTRIBUTE endclause    -- last clause in feature
01500 ::ATTRIBUTE owner        -- owning rexxprogram
01501  
01502 ::METHOD init
01503   use strict arg startline, startcol, endline, endcol, owner
01504   self~init:super(startline, startcol, endline, endcol)
01505   self~startclause = 0
01506   self~endclause = 0
01507   self~rname = ''
01508   self~owner = owner
01509  
01510 -- comparable on rexx name
01511 ::METHOD compareTo
01512   use arg other
01513   if other~rname > self~rname
01514     then return -1
01515   if other~rname < self~rname
01516     then return 1
01517   return 0
01518  
01519 -- return the object represented as a string
01520 ::METHOD makestring
01521   return self~makestring:super() self~rname self~startclause self~endclause
01522  
01523 -- specialization for a label
01524 -- it represents a Rexx label
01525 -- if the label represents a procedure or function
01526 -- but has no 'procedure' attribute, it will not be
01527 -- recognized as a procedure, but treated as 'just a label'
01528 -- Upper layers may wish to reassign this state, so .label inherits 
01529 -- the .callable mixin just in case
01530 ::CLASS label SUBCLASS feature INHERIT callable
01531 ::METHOD init
01532   use strict arg name, startline, startcol, endline, endcol, startclause, owner
01533   self~init:super(startline, startcol, endline, endcol, owner)
01534   self~rname = name
01535   self~objectname = 'LABL'
01536   self~startclause = startclause
01537  
01538  
01539 -- mixin for a callable feature
01540 --
01541 ::CLASS callable MIXINCLASS object
01542 ::ATTRIBUTE exposelist -- String list of exposed variabled
01543 ::ATTRIBUTE arglist    -- string list of arguments
01544 ::METHOD init
01545   self~exposelist = ''
01546   self~arglist = ''
01547   forward class(super)
01548  
01549 -- specialisation for a procedure
01550 -- a procedure is a feature with an exposelist and an arglist
01551 -- it represents a Rexx procedure
01552 ::CLASS proc SUBCLASS feature INHERIT callable
01553  
01554 ::METHOD init
01555   use strict arg name, startline, startcol, endline, endcol, startclause, owner
01556   self~init:super(startline, startcol, endline, endcol, owner)
01557   self~rname = name
01558   self~objectname = 'PROC'
01559   self~startclause = startclause
01560  
01561 -- specialization for a class
01562 -- a class is a feature with a number of specialized attributes
01563 -- it represents an OORexx class
01564 ::CLASS rclass SUBCLASS feature
01565 ::ATTRIBUTE public        -- when .true, class is public, else private
01566 ::ATTRIBUTE metaclass     -- string name of metaclass or ''
01567 ::ATTRIBUTE mixinclass    -- string list of mixinclass names or ''
01568 ::ATTRIBUTE subclass      -- string name of superclass or ''
01569 ::ATTRIBUTE inherit       -- string list of inherited classes or ''
01570  
01571 ::METHOD init
01572   use strict arg name, startline, startcol, endline, endcol, startclause, owner
01573   self~init:super(startline, startcol, endline, endcol, owner)
01574   self~rname = name
01575   self~objectname = 'CLAS'
01576   self~startclause = startclause
01577   self~public = .false -- private by default
01578   self~metaclass = ''
01579   self~mixinclass = ''
01580   self~subclass = ''
01581   self~inherit = ''
01582  
01583  
01584 -- mixin class for method and attribute common elements
01585 ::CLASS methodic MIXINCLASS object
01586  
01587 ::ATTRIBUTE cclass      -- when .true, method is a class method, else instance
01588 ::ATTRIBUTE public      -- when .true, method is public, else private
01589 ::ATTRIBUTE guarded     -- when .true, method is guarded, else unguarded
01590 ::ATTRIBUTE protected   -- when .true, method is protected, else unprotected
01591 ::ATTRIBUTE abstract    -- when .true, method is abstract, else concrete
01592 ::ATTRIBUTE ownerclass  -- when not .nil, containing method
01593 ::METHOD init
01594   self~cclass = .false -- instance method by default
01595   self~public = .true -- public by default
01596   self~guarded = .true -- guarded by default
01597   self~protected = .false -- unprotected by default
01598   self~abstract = .false -- concrete by default
01599   self~ownerclass = .nil -- no owner class by default
01600   forward class(super)
01601  
01602 -- specialization for a method
01603 -- a method is a feature with a number of specialized attributes
01604 -- it represents an OORexx method
01605 ::CLASS rmethod SUBCLASS feature inherit callable methodic
01606  
01607 ::METHOD init
01608   use strict arg name, startline, startcol, endline, endcol, startclause, owner
01609   self~init:super(startline, startcol, endline, endcol, owner)
01610   self~rname = name
01611   self~objectname = 'METH'
01612   self~startclause = startclause
01613  
01614 -- specialization for an attribute method
01615 -- an attribute is a feature with a number of specialized attributes
01616 -- it represents an OORexx attribute method 
01617 ::CLASS rattribute SUBCLASS feature INHERIT methodic
01618  
01619 ::ATTRIBUTE get         -- when .true, attribute is get-only
01620 ::ATTRIBUTE set         -- when .true, attribute is set-only
01621  
01622 ::METHOD init
01623   use strict arg name, startline, startcol, endline, endcol, startclause, owner
01624   self~init:super(startline, startcol, endline, endcol, owner)
01625   self~rname = name
01626   self~objectname = 'ATTR'
01627   self~startclause = startclause
01628   self~get = .false -- get-only specified when true
01629   self~set = .false -- set-only specified when true
01630  
01631 -- specialization for a routine
01632 -- a routine is a feature with a number of specialized attributes
01633 -- it represents an OORexx routine
01634 ::CLASS routine SUBCLASS feature INHERIT callable
01635 ::ATTRIBUTE public      -- when .true, method is public, else private
01636 ::METHOD init
01637   use strict arg name, startline, startcol, endline, endcol, startclause, owner
01638   self~init:super(startline, startcol, endline, endcol, owner)
01639   self~rname = name
01640   self~objectname = 'ROUT'
01641   self~startclause = startclause
01642   self~public = .false -- private by default
01643  
01644 -- specialization for a requires clause
01645 ::CLASS requires SUBCLASS feature
01646 ::METHOD init
01647   use strict arg name, startline, startcol, endline, endcol, startclause, owner
01648   self~init:super(startline, startcol, endline, endcol, owner)
01649   self~rname = name
01650   self~objectname = 'REQU'
01651   self~startclause = startclause
01652  
01653 -- specialization for an options clause
01654 ::CLASS roptions SUBCLASS feature
01655 ::METHOD init
01656   use strict arg optionlist, startline, startcol, endline, endcol, startclause, owner
01657   self~init:super(startline, startcol, endline, endcol, owner)
01658   self~rname = 'options'
01659   self~objectname = 'OPTS'
01660   self~startclause = startclause
01661  
01662 -- specialization for a constant clause
01663 ::CLASS rconstant SUBCLASS feature inherit callable methodic
01664 ::ATTRIBUTE varvalue
01665 ::METHOD init
01666   use strict arg varname, varvalue, startline, startcol, endline, endcol, startclause, owner
01667   self~init:super(startline, startcol, endline, endcol, owner)
01668   self~rname = varname
01669   self~varvalue = varvalue
01670   self~objectname = 'CONS'
01671   self~startclause = startclause
01672  
01673 -- a clause flattened for parsing
01674 ::CLASS flatclause PUBLIC
01675 ::ATTRIBUTE clause      -- the clause
01676 ::ATTRIBUTE linelengths -- lengths of each line in the clause
01677 ::ATTRIBUTE flat        -- the clause flattened, with string literals set to '*'
01678  
01679 -- @param clause - the clause
01680 -- @param src - queue of source lines corrersponding to clause
01681 ::METHOD init
01682   use arg clause, src
01683   self~clause = clause
01684   self~linelengths = .queue~new
01685   self~flat = ''
01686  
01687   do i over src
01688     self~linelengths~queue(i~length)
01689     self~flat = self~flat||i
01690     -- convert continuation comma to space
01691     if self~flat~right(1) = ','
01692       then do
01693              self~flat = self~flat~left(self~flat~length-1)' '
01694            end
01695   end
01696  
01697 -- convert an index position of the flat clause into a line/column vector
01698 -- in the clause
01699 -- @param index
01700 -- @return line column
01701 ::METHOD index2vector
01702   use arg index
01703   reloff = 0
01704  
01705   -- if self~clause~startline = 14 then trace ?i
01706  
01707   if index > self~flat~length
01708     then raise SYNTAX 93 ARRAY('index is' index 'line length is' self~flat~length)
01709  
01710  
01711   if index <= self~linelengths[1]
01712     then do
01713            return self~clause~startline index + self~clause~startcol -1
01714          end
01715  
01716   line = 0
01717   col = -1
01718   do i over self~linelengths
01719  
01720     if reloff + i >= index
01721       then do
01722              col = index - reloff
01723              leave
01724            end
01725     reloff = reloff + i
01726     line = line + 1
01727   end
01728   return line + self~clause~startline col
01729