home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / gnat-2.06-src.tgz / tar.out / fsf / gnat / ada / xtreeprs.spt < prev   
Text File  |  1996-09-28  |  8KB  |  237 lines
  1. *-----------------------------------------------------------------------------
  2. *-                                                                          --
  3. *-                                 G N A T                                  --
  4. *-                                                                          --
  5. *-                           COMPILER  UTILITIES                            --
  6. *-                                                                          --
  7. *-                             X T R E E P R S                              --
  8. *-                                                                          --
  9. *-                            $Revision: 1.27 $                             --
  10. *-                                                                          --
  11. *-           Copyright (c) 1992,1993,1994 NYU, All Rights Reserved          --
  12. *-                                                                          --
  13. *- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14. *- terms of the  GNU General Public License as published  by the Free Soft- --
  15. *- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16. *- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17. *- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18. *- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19. *- for  more details.  You should have  received  a copy of the GNU General --
  20. *- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21. *- to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. --
  22. *-                                                                          --
  23. *-----------------------------------------------------------------------------
  24.  
  25. * Program to construct the spec of the Treeprs package
  26. *
  27. *   Input files:
  28. *
  29. *      sinfo.ads     Spec of Sinfo package
  30. *      treeprs.adt   Template for Treeprs package
  31. *
  32. *   Output files:
  33. *
  34. *      treeprs.ads   Spec of Treeprs package
  35. *
  36. * Note: this program assumes that sinfo.ads has passed the error checks which
  37. * are carried out by the csinfo utility, so it does not duplicate these checks
  38. *
  39. * An optional argument allows the specification of an output file name to
  40. * override the default treeprs.ads file name for the generated output file.
  41.  
  42.         "$Revision: 1.27 $" "$Rev" "ision: " break(' ') $ treeprsrev
  43.  
  44.         lineno = 0
  45.         &stlimit = -1
  46.         input(.ins,1,'sinfo.ads')
  47.         input(.int,2,'treeprs.adt')
  48.  
  49.         arg = trim(host(1))
  50.         arg = ident(arg, "0") trim(host(0))
  51.         (ident(arg) output(.outs,3,'treeprs.ads'))
  52.         (differ(arg) output(.outs,3,arg))
  53.  
  54.         &anchor = 1
  55.         names = array(300)
  56.         positions = array(300)
  57.         count = 0
  58.         curpos = 1
  59.         wsp = span(' ' char(9))
  60.         strings = table(300)
  61.  
  62.  
  63. * Special fields table. The following fields are not included in the string
  64. * table constructed by xtreeprs, since they are specially handled in treeprs.
  65. * This means that these field definitions are completely ignored.
  66.  
  67.         special = table(20)
  68.         special<'Analyzed'> = 1
  69.         special<'Cannot_Be_Constant'> = 1
  70.         special<'Chars'> = 1
  71.         special<'Comes_From_Source'> = 1
  72.         special<'Error_Posted'> = 1
  73.         special<'Etype'> = 1
  74.         special<'Has_No_Side_Effects'> = 1
  75.         special<'Is_Controlling_Actual'> = 1
  76.         special<'Is_Overloaded'> = 1
  77.         special<'Is_Static_Expression'> = 1
  78.         special<'Left_Opnd'> = 1
  79.         special<'Must_Check_Expr'> = 1
  80.         special<'No_Overflow_Expr'> = 1
  81.         special<'Paren_Count'> = 1
  82.         special<'Raises_Constraint_Error'> = 1
  83.         special<'Right_Opnd'> = 1
  84.  
  85.         F_Field1       = '#'
  86.         F_Field2       = '$'
  87.         F_Field3       = '%'
  88.         F_Field4       = '&'
  89.         F_Field5       = "'"
  90.         F_Flag1        = "("
  91.         F_Flag2        = ")"
  92.         F_Flag3        = '*'
  93.         F_Flag4        = '+'
  94.         F_Flag5        = ','
  95.         F_Flag6        = '-'
  96.         F_Flag7        = '.'
  97.         F_Flag8        = '/'
  98.         F_Flag9        = '0'
  99.         F_Flag10       = '1'
  100.         F_Flag11       = '2'
  101.         F_Flag12       = '3'
  102.         F_Flag13       = '4'
  103.         F_Flag14       = '5'
  104.         F_Flag15       = '6'
  105.         F_Flag16       = '7'
  106.         F_Flag17       = '8'
  107.         F_Flag18       = '9'
  108.  
  109. * Get sinfo rev
  110.  
  111. slp     line = ins
  112.         line breakx('$') '$Rev' 'ision: ' break(' ') $ sinforev :f(slp)
  113.  
  114. * Copy initial part of template to spec
  115.  
  116. lp1     line = int                              :f(err)
  117.  
  118.         line breakx('$') '$Rev' 'ision: ' break(' ') $ temprev :f(lp1a)
  119.  
  120.         outs =
  121. .        '--                Generated by xtreeprs revision '
  122. .        treeprsrev ' using'
  123. .        '                 --'
  124.  
  125.         outs =
  126. .        '--                         sinfo.ads revision ' sinforev
  127. .        '                          --'
  128.  
  129.         outs =
  130. .        '--                        treeprs.adt revision ' temprev
  131. .        '                          --'     :(lp1)
  132.  
  133. * Skip lines describing the template
  134.  
  135. lp1a    line '--  This file is a template'      :f(lp1c)
  136.  
  137. lp1b    line = trim(int)                        :f(err)
  138.         differ(line)                            :s(lp1b)
  139.  
  140. lp1c    line 'package'                          :s(p1)
  141.         line breakx('T') $ a 'T e m p l a t e' =
  142. .            a '    S p e c    '
  143.         outs = line                             :(lp1)
  144.  
  145. p1      outs = line
  146.  
  147. * Copy rest of comments up to template insert point to spec
  148.  
  149. lp2x    line = int                              :f(err)
  150.         line '!!TEMPLATE INSERTION POINT'       :s(start)
  151.         outs = line                             :(lp2x)
  152.  
  153. * Here we are doing the actual insertions
  154.  
  155. start   outs = '   Pchars : constant String :='
  156.  
  157. lp      line = trim(ins)                :f(err)
  158.         lineno = lineno + 1
  159.         line wsp 'type Node_Kind'       :s(outc)
  160.  
  161.         line wsp '--  N_' rem $ node    :f(lp)
  162.         node break(' ,.')               :s(lp)
  163.  
  164.         outstring = node ' '
  165.  
  166. lp2     line = trim(ins)        :f(err)
  167.         ident(line)             :s(stringout)
  168.         line span(' ') '--  ' break(' ') $ synonym ' (' break(')') $ field
  169. .                                       :f(lp2)
  170.         synonym 'plus'                  :s(lp2)
  171.         differ(special<synonym>)        :s(lp2)
  172.         field break('-') $ field
  173.  
  174.         ffield = field
  175.  
  176.         field 'Flag'            :s(nxta)
  177.         field rtab(1) $ a = 'Field'
  178.  
  179. nxta    field = 'F_' field
  180.         field = $field
  181.         terminal = ident(field) "line " lineno " has unrecognized field name "
  182. .       ffield
  183.  
  184. nnn2    outstring = outstring field synonym :(lp2)
  185.  
  186. stringout
  187.         strings<node> = outstring           :(lp)
  188.  
  189. outc    line = trim(ins)                    :f(err)
  190.         line wsp 'N_' break(',)') $ syn
  191. .       len(1) $ term                       :f(outc)
  192.  
  193.         s = strings<syn>
  194.         s break(' ') $ node ' ' =
  195.         count = count + 1
  196.         names<count> = syn
  197.         positions<count> = curpos
  198.         curpos = curpos + size(s)
  199.  
  200.         outs = '      --  ' node
  201.  
  202.         ident(term,')')                     :s(outx)
  203.  
  204.         prefix = '      '
  205.  
  206. outcl   sp = 79 - 4 - size(prefix)
  207.         le(size(s),sp)                      :s(outcl2)
  208.         s len(sp) $ s1 =
  209.         outs = prefix '"' s1 '" &'
  210.         prefix =  '         '               :(outcl)
  211.  
  212. outcl2  outs = prefix '"' s '" &'            :(outc)
  213.  
  214. outx    sp = 79 - 4 - size(prefix)
  215.         le(size(s),sp)                      :s(outx2)
  216.         s len(sp) $ s1 =
  217.         outs = prefix '"' s1 '" &'
  218.         prefix =  '         '               :(outx)
  219.  
  220. outx2   outs = '      "' s '";'
  221.         outs =
  222.         outs = '   type Pchar_Pos_Array is array (Node_Kind) of Positive;'
  223.         outs = "   Pchar_Pos : constant Pchar_Pos_Array := "
  224. .                          "Pchar_Pos_Array'("
  225.         m = 0
  226.  
  227. outxl   eq(m = m + 1,count) :s(last)
  228.         name = rpad('N_' names<m>,40)
  229.         outs = "      " name ' => ' positions<m> ',' :(outxl)
  230.  
  231. last    name = rpad('N_' names<m>,40)
  232.         outs = "      " name ' => ' positions<m> ');'
  233.  
  234. vle     outs =
  235.         outs = "end Treeprs;"
  236. end
  237.