home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OL.LZH / IDOL.LZH / IDOL.IOL < prev    next >
Text File  |  1991-07-18  |  23KB  |  864 lines
  1. #
  2. # global variables
  3. #
  4. global fin,fout,fName,fLine,alpha,alphadot,white,nonwhite,nonalpha
  5. global classes,comp,exec,strict,links,imports,loud,compiles,compatible,ct
  6. #
  7. # gencode first generates specifications for all defined classes
  8. # It then imports those classes' specifications which it needs to
  9. # compute inheritance.  Finally, it writes out all classes' .icn files.
  10. #
  11. procedure gencode()
  12.   if \loud then write("Class import/export:")
  13.   #
  14.   # export specifications for each class
  15.   #
  16.   every cl := classes$foreach_t() do cl$writespec()
  17.   #
  18.   # import class specifications, transitively
  19.   #
  20.   repeat {
  21.     added := 0
  22.     every super:= ((classes$foreach_t())$foreachsuper() | !imports) do{
  23.       if /classes$lookup(super) then {
  24.     added := 1
  25.     fname := filename(super)
  26.     readinput(envpath(fname),2)
  27.     if /classes$lookup(super) then halt("can't import class '",super,"'")
  28.     writesublink(fname)
  29.       }
  30.     }
  31.     if added = 0 then break
  32.   }
  33.   #
  34.   # compute the transitive closure of the superclass graph
  35.   #
  36.   every (classes$foreach_t())$transitive_closure()
  37.   #
  38.   # generate output
  39.   #
  40.   if \loud then write("Generating code:")
  41.   writesublink("i_object")
  42.   every s := !links do writelink(s)
  43.   write(fout)
  44.   every out := $!classes do {
  45.     name := filename(out$name())
  46.     out$write()
  47.     put(compiles,name)
  48.     writesublink(name)
  49.   }
  50.   if *compiles>0 then return cdicont(compiles)
  51.   else return
  52. end
  53.  
  54. #
  55. # a class defining objects resulting from parsing lines of the form
  56. # tag name ( field1 , field2, ... )
  57. # If the constructor is given an argument, it is passed to self$read
  58. #
  59. class declaration(public name,fields,tag)
  60.   #
  61.   # parse a declaration string into its components
  62.   #
  63.   method read(decl)
  64.     decl ? (
  65.       (tab(many(white)) | "") ,
  66.       # get my tag
  67.       (self.tag := =("procedure"|"class"|"method"|"record")) ,
  68.       (tab(many(white)) | "") ,
  69.       # get my name
  70.       (self.name := tab(many(alpha))) ,
  71.       # get my fields
  72.       (tab(find("(")+1)),
  73.       (tab(many(white)) | "") ,
  74.       ((self.fields := classFields())$parse(tab(find(")"))))
  75.     ) | halt("declaration/read can't parse decl ",decl)
  76.   end
  77.  
  78.   #
  79.   # write a declaration; at the moment, only used by records
  80.   #
  81.   method write(f)
  82.      write(f,self$String())
  83.   end
  84.   #
  85.   # convert self to a string
  86.   #
  87.   method String()
  88.     return self.tag || " " || self.name || "(" || self.fields$String() || ")"
  89.   end
  90. initially
  91.   if \self.name then self$read(self.name)
  92. end
  93.  
  94. #
  95. # A class for ordinary Icon global declarations
  96. #
  97. class vardecl(s)
  98.   method write(f)
  99.     write(f,self.s)
  100.   end
  101. end
  102.  
  103. #
  104. # A class defining the constants for a given scope
  105. #
  106. class constant(t)
  107.   method expand(s)
  108.     i := 1
  109.     #
  110.     # conditions for expanding a constant:
  111.     # must not be within a larger identifier nor within a quote
  112.     #
  113.     while ((i <- find(k <- $!self,s,i)) & ((i=1) | any(nonalpha,s[i-1])) &
  114.       ((*s = i+*k-1) | any(nonalpha,s[i+*k])) &
  115.           notquote(s[1:i])) do {
  116.     val := \ (self.t[k]) | stop("internal error in expand")
  117.     s[i +: *k] := val
  118. #    i +:= *val
  119.     }
  120.     return s
  121.   end
  122.   method foreach() # in this case, we mean the keys, not the values
  123.     suspend key(self.t)
  124.   end
  125.   method eval(s)
  126.     if s2 := \ self.t[s] then return s2
  127.   end
  128.   method parse(s)
  129.     s ? {
  130.     k := trim(tab(find(":="))) | fail
  131.     move(2)
  132.     tab(many(white))
  133.     val := tab(0) | fail
  134.     (*val > 0) | fail
  135.     self.t [ k ] := val
  136.     }
  137.     return
  138.   end
  139.   method append(cd)
  140.     every s := cd$parse do self$parse(s)
  141.   end
  142. initially
  143.   self.t := table()
  144. end
  145.  
  146. #
  147. # A class defining a single constant declaration
  148. #
  149. class constdcl : vardecl()
  150.   # suspend the individual constant := value strings
  151.   method parse()
  152.     self.s ? {
  153.     tab(find("const")+6)
  154.     tab(many(white))
  155.     while s2 := trim(tab(find(","))) do {
  156.         suspend s2
  157.         move(1)
  158.         tab(many(white))
  159.     }
  160.     suspend trim(tab(0))
  161.     }
  162.   end
  163. end
  164.  
  165. #
  166. # class body manages a list of strings holding the code for
  167. # procedures/methods/classes
  168. #
  169. class body(fn,ln,vars,text)
  170.   method read()
  171.     self.fn    := fName
  172.     self.ln    := fLine
  173.     self.text  := []
  174.     while line := readln() do {
  175.       put(self.text, line)
  176.       line ? {
  177.       tab(many(white))
  178.       if ="end" & &pos > *line then return
  179.       else if =("local"|"static"|"initial") & any(nonalpha) then {
  180.           self.ln +:= 1
  181.           pull(self.text)
  182.           / (self.vars) := []
  183.           put(self.vars, line)
  184.       }
  185.       }
  186.     }
  187.     halt("body/read: eof inside a procedure/method definition")
  188.   end
  189.   method write(f)
  190.     if \self.vars then every write(f,!self.vars)
  191.     if \compatible then write(f,"  \\self := self.__state")
  192.     if \self.ln then
  193.     write(f,"#line ",self.ln + ((*\self.vars)|0)," \"",self.fn,"\"")
  194.     every write(f,$!self)
  195.   end
  196.   method delete()
  197.     return pull(self.text)
  198.   end
  199.   method size()
  200.     return (*\ (self.text)) | 0
  201.   end
  202.   method foreach()
  203.     if t := \self.text then suspend !self.text
  204.   end
  205. end
  206.  
  207. #
  208. # a class defining operations on classes
  209. #
  210. class class : declaration (supers,methods,text,imethods,ifields,glob)
  211.   # imethods and ifields are all lists of these:
  212.   record classident(class,ident)
  213.  
  214.   method read(line,phase)
  215.     self$declaration.read(line)
  216.     self.supers := idTaque(":")
  217.     self.supers$parse(line[find(":",line)+1:find("(",line)] | "")
  218.     self.methods:= taque()
  219.     self.text   := body()
  220.     while line  := readln("wrap") do {
  221.       line ? {
  222.     tab(many(white))
  223.     if ="initially" then {
  224.         self.text$read()
  225.         if phase=2 then return
  226.         self.text$delete()    # "end" appended manually during writing after
  227.                 # generation of the appropriate return value
  228.         return
  229.     } else if ="method" then {
  230.         decl := method(self.name)
  231.         decl$read(line,phase)
  232.         self.methods$insert(decl,decl$name())
  233.     } else if ="end" then {
  234.         # "end" is tossed here. see "initially" above
  235.         return
  236.     } else if ="procedure" then {
  237.         decl := method("")
  238.         decl$read(line,phase)
  239.         /self.glob := []
  240.         put(self.glob,decl)
  241.     } else if ="global" then {
  242.         /self.glob := []
  243.         put(self.glob,vardecl(line))
  244.     } else if ="record" then {
  245.         /self.glob := []
  246.         put(self.glob,declaration(line))
  247.     } else if upto(nonwhite) then {
  248.         halt("class/read expected declaration on: ",line)
  249.     }
  250.       }
  251.     }
  252.     halt("class/read syntax error: eof inside a class definition")
  253.   end
  254.  
  255.   #
  256.   # Miscellaneous methods on classes
  257.   #
  258.   method has_initially()
  259.     return $*self.text > 0
  260.   end
  261.   method ispublic(fieldname)
  262.     if self.fields$ispublic(fieldname) then return fieldname
  263.   end
  264.   method foreachmethod()
  265.     suspend $!self.methods
  266.   end
  267.   method foreachsuper()
  268.     suspend $!self.supers
  269.   end
  270.   method foreachfield()
  271.     suspend $!self.fields
  272.   end
  273.   method isvarg(s)
  274.     if self.fields$isvarg(s) then return s
  275.   end
  276.   method transitive_closure()
  277.     count := $*self.supers
  278.     while count > 0 do {
  279.     added := taque()
  280.     every sc := $!self.supers do {
  281.       if /(super := classes$lookup(sc)) then
  282.         halt("class/transitive_closure: couldn't find superclass ",sc)
  283.       every supersuper := super$foreachsuper() do {
  284.         if / self.supers$lookup(supersuper) &
  285.          /added$lookup(supersuper) then {
  286.           added$insert(supersuper)
  287.         }
  288.       }
  289.     }
  290.     count := $*added
  291.     every self.supers$insert($!added)
  292.     }
  293.   end
  294.   #
  295.   # write the class declaration: if s is "class" write as a spec
  296.   # otherwise, write as a constructor
  297.   #
  298.   method writedecl(f,s)
  299.     writes(f, s," ",self.name)
  300.     if s=="class" & ( *(supers := self.supers$String()) > 0 ) then
  301.         writes(f," : ",supers)
  302.     writes(f,"(")
  303.     rv := self.fields$String(s)
  304.     if *rv > 0 then rv ||:= ","
  305.     if s~=="class" & *(\self.ifields)>0 then    {    # inherited fields
  306.       every l := !self.ifields do rv ||:= l.ident || ","
  307.       if /(superclass := classes$lookup(l.class)) then
  308.       halt("class/resolve: couldn't find superclass ",sc)
  309.       if superclass$isvarg(l.ident) then rv := rv[1:-1]||"[],"
  310.     }
  311.     writes(f,rv[1:-1])
  312.     write(f,,")")
  313.   end
  314.   method writespec(f) # write the specification of a class
  315.     f := envopen(filename(self.name),"w")
  316.     self$writedecl(f,"class")
  317.     every ($!self.methods)$writedecl(f,"method")
  318.     if self$has_initially() then write(f,"initially")
  319.     write(f,"end")
  320.     close(f)
  321.   end
  322.  
  323.   #
  324.   # write out the Icon code for this class' explicit methods
  325.   # and its "nested global" declarations (procedures, records, etc.)
  326.   #
  327.   method writemethods()
  328.     f:= envopen(filename(self.name,".icn"),"w")
  329.     every ($!self.methods)$write(f,self.name)
  330.  
  331.     if \self.glob & *self.glob>0 then {
  332.     write(f,"#\n# globals declared within the class\n#")
  333.     every i := 1 to *self.glob do (self.glob[i])$write(f,"")
  334.     }
  335.     close(f)
  336.   end
  337.  
  338.   #
  339.   # write - write an Icon implementation of a class to file f
  340.   #
  341.   method write()
  342.     f:= envopen(filename(self.name,".icn"),"a")
  343.     #
  344.     # must have done inheritance computation to write things out
  345.     #
  346.     if /self.ifields then self$resolve()
  347.  
  348.     #
  349.     # write a record containing the state variables
  350.     #
  351.     writes(f,"record ",self.name,"__state(__state,__methods") # reserved fields
  352.     rv := ","
  353.     rv ||:= self.fields$idTaque.String()             # my fields
  354.     if rv[-1] ~== "," then rv ||:= ","
  355.     every s := (!self.ifields).ident do rv ||:= s || "," # inherited fields
  356.     write(f,rv[1:-1],")")
  357.  
  358.     #
  359.     # write a record containing the methods
  360.     #
  361.     writes(f,"record ",self.name,"__methods(")
  362.     rv := ""
  363.  
  364.     every s := ((($!self.methods)$name())    |    # my explicit methods
  365.         self.fields$foreachpublic()    |    # my implicit methods
  366.         (!self.imethods).ident        |    # my inherited methods
  367.         $!self.supers)                # super.method fields
  368.     do rv ||:= s || ","
  369.  
  370.     if *rv>0 then rv[-1] := ""            # trim trailling ,
  371.     write(f,rv,")")
  372.  
  373.     #
  374.     # write a global containing this classes' operation record
  375.     # along with declarations for all superclasses op records
  376.     #
  377.     writes(f,"global ",self.name,"__oprec")
  378.     every writes(f,", ", $!self.supers,"__oprec")
  379.     write(f)
  380.  
  381.     #
  382.     # write the constructor procedure.
  383.     # This is a long involved process starting with writing the declaration.
  384.     #
  385.     self$writedecl(f,"procedure")
  386.     write(f,"local self,clone")
  387.  
  388.     #
  389.     # initialize operation records for this and superclasses
  390.     #
  391.     write(f,"initial {\n",
  392.         "  if /",self.name,"__oprec then ",self.name,"initialize()")
  393.     if $*self.supers > 0 then
  394.     every (super <- $!self.supers) ~== self.name do
  395.         write(f,"  if /",super,"__oprec then ",super,"initialize()\n",
  396.             "  ",self.name,"__oprec.",super," := ", super,"__oprec")
  397.     write(f,"  }")
  398.  
  399.     #
  400.     # create self, initialize from constructor parameters
  401.     #
  402.     writes(f,"  self := ",self.name,"__state(&null,",self.name,"__oprec")
  403.     every writes(f,",",$!self.fields)
  404.     if \self.ifields then every writes(f,",",(!self.ifields).ident)
  405.     write(f,")\n  self.__state := self")
  406.  
  407.     #
  408.     # call my own initially section, if any
  409.     #
  410.     if $*self.text > 0 then write(f,"  ",self.name,"initially(self)")
  411.  
  412.     #
  413.     # call superclasses' initially sections
  414.     #
  415.     if $*self.supers > 0 then {
  416.     every (super <- $!self.supers) ~== self.name do {
  417.         if (classes$lookup(super))$has_initially() then {
  418.         if /madeclone := 1 then {
  419.             write(f,"  clone := ",self.name,"__state()\n",
  420.             "  clone.__state := clone\n",
  421.             "  clone.__methods := ",self.name,"__oprec")
  422.         }
  423.         write(f,"  # inherited initialization from class ",super)
  424.         write(f,"    every i := 2 to *self do clone[i] := self[i]\n",
  425.             "    ",super,"initially(clone)")
  426.         every l := !self.ifields do {
  427.             if l.class == super then
  428.             write(f,"    self.",l.ident," := clone.",l.ident)
  429.         }
  430.         }
  431.     }
  432.     }
  433.  
  434.     #
  435.     # return the pair that comprises the object:
  436.     # a pointer to the instance (__mystate), and
  437.     # a pointer to the class operation record
  438.     #
  439.     write(f,"  return idol_object(self,",self.name,"__oprec)\n",
  440.         "end\n")
  441.     
  442.     #
  443.     # write out class initializer procedure to initialize my operation record
  444.     #
  445.     write(f,"procedure ",self.name,"initialize()")
  446.     writes(f,"  initial ",self.name,"__oprec := ",self.name,"__methods")
  447.     rv := "("
  448.     every s := ($!self.methods)$name() do {        # explicit methods
  449.       if *rv>1 then rv ||:= ","
  450.       rv ||:= self.name||"_"||s
  451.     }
  452.     every me := self.fields$foreachpublic() do {    # implicit methods
  453.       if *rv>1 then rv ||:= ","            # (for public fields)
  454.       rv ||:= self.name||"_"||me
  455.     }
  456.     every l := !self.imethods do {            # inherited methods
  457.       if *rv>1 then rv ||:= ","
  458.       rv ||:= l.class||"_"||l.ident
  459.     }
  460.     write(f,rv,")\n","end")
  461.     #
  462.     # write out initially procedure, if any
  463.     #
  464.     if self$has_initially() then {
  465.     write(f,"procedure ",self.name,"initially(self)")
  466.     self.text$write(f)
  467.     write(f,"end")
  468.     }
  469.  
  470.     #
  471.     # write out implicit methods for public fields
  472.     #
  473.     every me := self.fields$foreachpublic() do {
  474.       write(f,"procedure ",self.name,"_",me,"(self)")
  475.       if \strict then {
  476.     write(f,"  if type(self.",me,") == ",
  477.         "(\"list\"|\"table\"|\"set\"|\"record\") then\n",
  478.         "    runerr(501,\"idol: scalar type expected\")")
  479.     }
  480.       write(f,"  return .(self.",me,")")
  481.       write(f,"end")
  482.       write(f)
  483.     }
  484.  
  485.     close(f)
  486.  
  487.   end
  488.  
  489.   #
  490.   # resolve -- primary inheritance resolution utility
  491.   #
  492.   method resolve()
  493.     #
  494.     # these are lists of [class , ident] records
  495.     #
  496.     self.imethods := []
  497.     self.ifields := []
  498.     ipublics := []
  499.     addedfields := table()
  500.     addedmethods := table()
  501.     every sc := $!self.supers do {
  502.     if /(superclass := classes$lookup(sc)) then
  503.         halt("class/resolve: couldn't find superclass ",sc)
  504.     every superclassfield := superclass$foreachfield() do {
  505.         if /self.fields$lookup(superclassfield) &
  506.            /addedfields[superclassfield] then {
  507.         addedfields[superclassfield] := superclassfield
  508.         put ( self.ifields , classident(sc,superclassfield) )
  509.         if superclass$ispublic(superclassfield) then
  510.             put( ipublics, classident(sc,superclassfield) )
  511.         } else if \strict then {
  512.         warn("class/resolve: '",sc,"' field '",superclassfield,
  513.              "' is redeclared in subclass ",self.name)
  514.         }
  515.     }
  516.     every superclassmethod := (superclass$foreachmethod())$name() do {
  517.         if /self.methods$lookup(superclassmethod) &
  518.            /addedmethods[superclassmethod] then {
  519.         addedmethods[superclassmethod] := superclassmethod
  520.         put ( self.imethods, classident(sc,superclassmethod) )
  521.         }
  522.     }
  523.     every public := (!ipublics) do {
  524.         if public.class == sc then
  525.         put (self.imethods, classident(sc,public.ident))
  526.     }
  527.     }
  528.   end
  529. end
  530.  
  531. #
  532. # a class defining operations on methods and procedures
  533. #
  534. class method : declaration (class,text)
  535.   method read(line,phase)
  536.     self$declaration.read(line)
  537.     self.text := body()
  538.     if phase = 1 then
  539.       self.text$read()
  540.   end
  541.   method writedecl(f,s)
  542.     decl := self$String()
  543.     if s == "method" then decl[1:upto(white,decl)] := "method"
  544.     else {
  545.     decl[1:upto(white,decl)] := "procedure"
  546.     if *(self.class)>0 then {
  547.         decl[upto(white,decl)] ||:= self.class||"_"
  548.         i := find("(",decl)
  549.         decl[i] ||:= "self" || (((decl[i+1] ~== ")"), ",") | "")
  550.     }
  551.     }
  552.     write(f,decl)
  553.   end
  554.   method write(f)
  555.     if self.name ~== "initially" then
  556.     self$writedecl(f,"procedure")
  557.     self.text$write(f)
  558.     self.text := &null            # after writing out text, forget it!
  559.   end
  560. end
  561.  
  562. #
  563. # a class corresponding to an Icon table, with special treatment of empties
  564. #
  565. class Table(t)
  566.   method size()
  567.     return (* \ self.t) | 0
  568.   end
  569.   method insert(x,key)
  570.     /self.t := table()
  571.     /key := x
  572.     if / (self.t[key]) := x then return
  573.   end
  574.   method lookup(key)
  575.     if t := \self.t then return t[key]
  576.     return
  577.   end
  578.   method foreach()
  579.     if t := \self.t then every suspend !self.t
  580.   end
  581. end
  582.  
  583. #
  584. # tabular queues (taques):
  585. # a class defining objects which maintain synchronized list and table reps
  586. # Well, what is really provided are loosely-coordinated list/tables
  587. #
  588. class taque : Table (l)
  589.   method insert(x,key)
  590.     /self.l := []
  591.     if self$Table.insert(x,key) then put(self.l,x)
  592.   end
  593.   method foreach()
  594.     if l := \self.l then every suspend !self.l
  595.   end
  596.   method insert_t(x,key)
  597.     self$Table.insert(x,key)
  598.   end
  599.   method foreach_t()
  600.     suspend self$Table.foreach()
  601.   end
  602. end
  603.  
  604. #
  605. # support for taques found as lists of ids separated by punctuation
  606. # constructor called with (separation char, source string)
  607. #
  608. class idTaque : taque(punc)
  609.   method parse(s)
  610.     s ? {
  611.       tab(many(white))
  612.       while name := tab(find(self.punc)) do {
  613.     self$insert(trim(name))
  614.     move(1)
  615.     tab(many(white))
  616.       }
  617.       if any(nonwhite) then self$insert(trim(tab(0)))
  618.     }
  619.     return
  620.   end
  621.   method String()
  622.     if /self.l then return ""
  623.     out := ""
  624.     every id := !self.l do out ||:= id||self.punc
  625.     return out[1:-1]
  626.   end
  627. end
  628.  
  629. #
  630. # parameter lists in which the final argument may have a trailing []
  631. #
  632. class argList : idTaque(public varg)
  633.   method insert(s)
  634.     if \self.varg then halt("variable arg must be final")
  635.     if i := find("[",s) then {
  636.       if not (j := find("]",s)) then halt("variable arg expected ]")
  637.       s[i : j+1] := ""
  638.       self.varg := s := trim(s)
  639.     }
  640.     self$idTaque.insert(s)
  641.   end
  642.   method isvarg(s)
  643.     if s == \self.varg then return s
  644.   end
  645.   method String()
  646.     return self$idTaque.String() || ((\self.varg & "[]") | "")
  647.   end
  648. initially
  649.   self.punc := ","
  650. end
  651.  
  652. #
  653. # Idol class field lists in which fields may be preceded by a "public" keyword
  654. #
  655. class classFields : argList(publics)
  656.   method String(s)
  657.     if *(rv := self$argList.String()) = 0 then return ""
  658.     if /s | (s ~== "class") then return rv
  659.     if self$ispublic(self.l[1]) then rv := "public "||rv
  660.     every field:=self$foreachpublic() do rv[find(","||field,rv)] ||:= "public "
  661.     return rv
  662.   end
  663.   method foreachpublic()
  664.     if \self.publics then every suspend !self.publics
  665.   end
  666.   method ispublic(s)
  667.     if \self.publics then every suspend !self.publics == s
  668.   end
  669.   method insert(s)
  670.     s ? {
  671.       if ="public" & tab(many(white)) then {
  672.     s := tab(0)
  673.     /self.publics := []
  674.     put(self.publics,s)
  675.       }
  676.     }
  677.     self$argList.insert(s)
  678.   end
  679. initially
  680.   self.punc := ","
  681. end
  682.  
  683. #
  684. # procedure to read a single Idol source file
  685. #
  686. procedure readinput(name,phase,ct2)
  687.     if \loud then write("\t",name)
  688.     fName := name
  689.     fLine := 0
  690.     fin   := sysopen(name,"r")
  691.     ct    := \ct2 | constant()
  692.     while line := readln("wrap") do {
  693.     line ? {
  694.         tab(many(white))
  695.         if ="class" then {
  696.         decl := class()
  697.         decl$read(line,phase)
  698.         if phase=1 then {
  699.             decl$writemethods()
  700.             classes$insert(decl,decl$name())
  701.         } else classes$insert_t(decl,decl$name())
  702.         }
  703.         else if ="procedure" then {
  704.         if comp = 0 then comp := 1
  705.         decl := method("")
  706.         decl$read(line,phase)
  707.         decl$write(fout,"")
  708.         }
  709.         else if ="record" then {
  710.         if comp = 0 then comp := 1
  711.         decl := declaration(line)
  712.         decl$write(fout,"")
  713.         }
  714.         else if ="global" then {
  715.         if comp = 0 then comp := 1
  716.         decl := vardecl(line)
  717.         decl$write(fout,"")
  718.         }
  719.         else if ="const" then {
  720.         ct$append ( constdcl(line) )
  721.             }
  722.         else if ="method" then {
  723.         halt("readinput: method outside class")
  724.             }
  725.         else if ="#include" then {
  726.         savedFName := fName
  727.         savedFLine := fLine
  728.         savedFIn   := fin
  729.         tab(many(white))
  730.         readinput(tab(if ="\"" then find("\"") else many(nonwhite)),
  731.               phase,ct)
  732.         fName := savedFName
  733.         fLine := savedFLine
  734.         fin   := savedFIn
  735.             }
  736.     }
  737.     }
  738.     close(fin)
  739. end
  740.  
  741. #
  742. # filter the input translating $ references
  743. # (also eats comments and trims lines)
  744. #
  745. procedure readln(wrap)
  746.   count := 0
  747.   prefix := ""
  748.   while /finished do {
  749.  
  750.     if not (line := read(fin)) then fail
  751.     fLine +:= 1
  752.     if match("#include",line) then return line
  753.     line[ 1(x<-find("#",line),notquote(line[1:x])) : 0] := ""
  754.     line := trim(line,white)
  755. #    line := selfdot(line)
  756.     x := 1
  757.     while ((x := find("$",line,x)) & notquote(line[1:x])) do {
  758.       z := line[x+1:0] ||" "         # " " is for bal()
  759.       case line[x+1] of {
  760.         #
  761.         # IBM 370 digraphs
  762.         #
  763.         "(": line[x+:2] := "{"
  764.         ")": line[x+:2] := "}"
  765.         "<": line[x+:2] := "["
  766.         ">": line[x+:2] := "]"
  767.         #
  768.         # Invocation operators $! $* $@ $? (for $$ see below)
  769.         #
  770.         "!"|"*"|"@"|"?": {
  771.           z ? {
  772.         move(1)
  773.         tab(many(white))
  774.         if not (id := tab(many(alphadot))) then {
  775.           if not match("(") then halt("readln can't parse ",line)
  776.           if not (id := tab(&pos<bal())) then
  777.           halt("readln: cant bal ",&subject)
  778.         }
  779.         Op := case line[x+1] of {
  780.         "@": "activate"
  781.         "*": "size"
  782.         "!": "foreach"
  783.         "?": "random"
  784.         }
  785.         count +:= 1
  786.         line[x:0] :=
  787.         "(__self"||count||" := "||id||").__methods."||
  788.         Op||"(__self"||count||".__state)"||tab(0)
  789.       }
  790.         }
  791.     #
  792.     # x $[ y ] shorthand for x$index(y)
  793.     #
  794.     "[": {
  795.         z ? {
  796.         if not (middle := tab((&pos<bal(&cset,'[',']'))-1)[2:0]) then
  797.             halt("readln: can't bal([) ",&subject)
  798.         tail := tab(0)|""
  799.         line := line[1:x]||"$index("||middle||")"||(tab(0)|"")
  800.         }
  801.     }
  802.         default: {
  803.         #
  804.         # get the invoking object.
  805.         #
  806.         reverse(line[1:x])||" " ? {
  807.         tab(many(white))
  808.         if not (id := reverse(tab(many(alphadot)))) then {
  809.             if not match(")") then halt("readln: can't parse")
  810.             if not (id := reverse(tab(&pos<bal(&cset,')','('))))
  811.             then halt("readln: can't bal ",&subject)
  812.         }
  813.         objlen := &pos-1
  814.         }
  815.         count +:= 1
  816.         front := "(__self"||count||" := "||id||").__methods."
  817.         back := "__self"||count||".__state"
  818.  
  819.         #
  820.         # get the method name
  821.         #
  822.         z ? {
  823.         ="$"
  824.         tab(many(white))
  825.         if not (methodname := tab(many(alphadot))) then
  826.             halt("readln: expected a method name after $")
  827.         tab(many(white))
  828.         methodname ||:= "("
  829.         if ="(" then {
  830.             tab(many(white))
  831.             afterlp := &subject[&pos]
  832.         }
  833.         else {
  834.             afterlp := ")"
  835.             back ||:= ")"
  836.         }
  837.         methlen := &pos-1
  838.         }
  839.         if line[x+1] == "$" then {
  840.         c := if afterlp[1] ~== ")" then "" else "[]"
  841.         methodname[-1] := "!("
  842.         back := "["||back||"]|||"
  843.         } else {
  844.         c := if (\afterlp)[1] == ")" then "" else ","
  845.         }
  846.         line[x-objlen : (((*line>=(x+methlen+1))|0)\1)] :=
  847.         front || methodname || back || c
  848.     }
  849.       } # case
  850.     } # while there's a $ to process
  851.     if /wrap | (prefix==line=="") then finished := line
  852.     else {
  853.     prefix ||:= line || " "            # " " is for bal()
  854.     prefix ? {
  855.         # we are done if the line is balanced wrt parens and
  856.         # doesn't end in a continuation character (currently just ,)
  857.         if ((*prefix = bal()) & (not find(",",prefix[-2]))) then
  858.         finished := prefix[1:-1]
  859.     }
  860.     }
  861.   } # while / finished
  862.   return ct$expand(finished)
  863. end
  864.