home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / oper_sys / emerald / emrldsys.lha / Language / Compiler / Builtins / Array.m < prev    next >
Encoding:
Text File  |  1990-08-16  |  10.6 KB  |  366 lines
  1. % 
  2. % @(#)real_Array.m    1.3  7/13/87
  3. %
  4. export _ArrayObject to "Builtins"
  5.  
  6. const _ArrayObject == 
  7.   immutable object _ArrayObject
  8.     export of
  9.     function of [ElementType : AbstractType] -> [result : NAT]
  10.       where
  11.     NAT ==    immutable type NAT
  12.           operation empty -> [NA]
  13.           operation literal [RIS] -> [NA]
  14.           operation create[Integer] -> [NA]
  15.           function getSignature -> [Signature]
  16.         end NAT
  17.     RIS ==  type i_RIS
  18.           function getElement [Integer] -> [ElementType]
  19.           function upperbound -> [Integer]
  20.           function lowerbound -> [Integer]
  21.         end i_RIS
  22.     NA ==    type NA
  23.           function  getElement [Integer] -> [ElementType]
  24.             % get the element indexed by index, failing if index 
  25.             % out of range.
  26.           operation setElement [Integer, ElementType]
  27.             % set the element, failing if index out of range
  28.           function  upperbound -> [Integer]
  29.             % return the highest valid index, ub.
  30.           function  lowerbound -> [Integer]
  31.             % return the lowest valid index, lb.
  32.           function  getSlice [Integer, Integer] -> [NA]
  33.             % return a new array, a, with lower bound lb, and 
  34.             % upper bound ub, such that for lb <= i <= ub:
  35.             %     self.getElement[i] == a.getElement[i]
  36.             % fail if lb or ub is out of range.
  37.           operation setSlice [Integer, Integer, RIS]
  38.             % set the elements indexed by i for lb <= i <= ub, so 
  39.             % that for each such i:
  40.             %     self.getElement[i] == a.getElement[i]
  41.             % fail if lb or ub is out of range.
  42.           operation slideTo [Integer]
  43.             % change the valid indicies for self.  Assuming 
  44.             % the old indicies ranged from lb to ub, the new 
  45.             % indicies will range from i to i + ub - lb
  46.           operation addUpper [ElementType]
  47.             % extend the set of valid indicies, changing ub to 
  48.             % ub + 1, and setting the element indexed by the new
  49.             % ub to be e.
  50.           operation removeUpper -> [ElementType]
  51.             % return the element indexed by ub, after contracting 
  52.             % the set of valid indicies to lb <= i <= ub - 1.
  53.           operation addLower [ElementType]
  54.             % extend the set of valid indicies, changing lb to 
  55.             % lb - 1, and setting
  56.             % the element indexed by the new lb to be e.
  57.           operation removeLower -> [ElementType]
  58.             % return the element indexed by lb, after contracting 
  59.             % the set of valid indicies to lb + 1 <= i <= ub.
  60.           function  empty -> [Boolean]
  61.             % -> true if lb == ub + 1, which is true initially,
  62.             % since initially lb = 1, and ub = 0.
  63.           operation catenate [a : RIS] -> [r : NA]
  64.             % extend the range of valid indicies from lb .. ub to 
  65.             % lb .. ub + a.length.  Set these new elements to refer
  66.             % to the elements of a so that for a.lb <= i <= a.ub, 
  67.             % where oub is the old value of self.ub:
  68.             %     a.getElement[i] == self.getElement[oub + i - 1]
  69.         end NA
  70.     ElementType *> type T end T
  71.       end where
  72.  
  73.       result <- 
  74.     immutable object aNAT
  75.       export empty, create, getSignature, literal
  76.  
  77.       const ve == Vector.of[ElementType]
  78.  
  79.       function getSignature -> [result : Signature]
  80.         result <- NA
  81.       end getSignature
  82.  
  83.       operation create[length : Integer] -> [result : NA]
  84.         result <-
  85.           object aNA
  86.         export getElement, setElement, upperbound, lowerbound, getSlice, setSlice,
  87.                slideTo, addUpper, removeUpper, addLower,
  88.                removeLower, empty, catenate
  89.  
  90.         monitor
  91.           var lwb, upb, firstIndex, lastIndex : Integer
  92.           var currentSize, maxSize : Integer
  93.           attached var vec: ve
  94.           
  95.           function  getElement [i : Integer] -> [r : ElementType]
  96.             var index : Integer
  97.             assert i >= lwb
  98.             assert i <= upb
  99.             index <- (i - lwb) + firstIndex
  100.             if index >= maxSize then
  101.               index <- index - maxSize
  102.             end if
  103.             r <- vec(index)
  104.           end getElement
  105.  
  106.           operation setElement [i : Integer, r : ElementType]
  107.             var index : Integer
  108.             assert i >= lwb
  109.             assert i <= upb
  110.             index <- (i - lwb) + firstIndex
  111.             if index >= maxSize then
  112.               index <- index - maxSize
  113.             end if
  114.             vec(index) := r
  115.           end setElement
  116.  
  117.           function  upperbound -> [r : Integer]
  118.             r <- upb
  119.           end upperbound
  120.  
  121.           function  lowerbound -> [r : Integer]
  122.             r <- lwb
  123.           end lowerbound
  124.  
  125.           % return a new Array, a, with lower bound lwb, and 
  126.           % upper bound upb, such that for lwb <= i <= upb:
  127.           %     self.getElement[i] == a.getElement[i]
  128.           % fail if lwb or upb is out of range.
  129.           function  getSlice [i1 : Integer, l : Integer] -> [r : NA]
  130.             var index : Integer
  131.             var i : Integer <- 0
  132.             assert l >= 0
  133.             assert i1 >= lwb
  134.             assert i1+l-1 <= upb
  135.             r <- aNAT.create[l]
  136.             r.slideTo[i1]
  137.             index <- (i1 - lwb) + firstIndex
  138.             if index >= maxSize then
  139.               index <- index - maxSize
  140.             end if
  141.             loop
  142.               exit when i >= l
  143.               r(i1 + i) := vec(index)
  144.               i <- i + 1
  145.               index <- index + 1
  146.               if index >= maxSize then
  147.             index <- index - maxSize
  148.               end if
  149.             end loop
  150.           end getSlice
  151.  
  152.           % set the elements indexed by i for lwb <= i <= upb, so 
  153.           % that for each such i:
  154.           %     self.getElement[i] == a.getElement[i]
  155.           % fail if lwb or upb is out of range.
  156.           operation setSlice [i1 : Integer, l : Integer, s : RIS]
  157.             var index : Integer
  158.             var i : Integer <- 0
  159.             assert l >= 0
  160.             assert i1 >= lwb
  161.             assert i1 + l <= upb
  162.             assert i1 >= s.lowerbound
  163.             assert i1 + l <= s.upperbound
  164.             index <- (i1 - lwb) + firstIndex
  165.             if index >= maxSize then
  166.               index <- index - maxSize
  167.             end if
  168.             loop
  169.               exit when i >= l
  170.               vec(index) := s(i1 + i)
  171.               i <- i + 1
  172.               index <- index + 1
  173.               if index >= maxSize then
  174.             index <- index - maxSize
  175.               end if
  176.             end loop
  177.           end setSlice
  178.  
  179.           % change the valid indicies for self.  Assuming 
  180.           % the old indicies ranged from lwb to upb, the new 
  181.           % indicies will range from i to i + upb - lwb
  182.           operation slideTo [i : Integer]
  183.             var difference : Integer <- lwb - i
  184.             lwb <- lwb - difference
  185.             upb <- upb - difference
  186.           end slideTo
  187.  
  188.           % extend the set of valid indicies, changing upb to 
  189.           % upb + 1, and setting the element indexed by the new
  190.           % upb to be e.
  191.           operation addUpper [e : ElementType]
  192.             var index : Integer
  193.             if currentSize = maxSize then
  194.               var nvec : ve
  195.               const nMaxSize : Integer == maxSize * 2
  196.               var oldIndex : Integer <- firstIndex
  197.               var newIndex : Integer <- 0
  198.               nvec <- ve.create[nMaxSize]
  199.               loop
  200.             exit when newIndex >= maxSize
  201.             nvec(newIndex) := vec(oldIndex)
  202.             newIndex <- newIndex + 1
  203.             oldIndex <- oldIndex + 1
  204.             if oldIndex >= maxSize then
  205.               oldIndex <- oldIndex - maxSize
  206.             end if
  207.               end loop
  208.               firstIndex <- 0
  209.               lastIndex <- maxSize - 1
  210.               maxSize <- nMaxSize
  211.               vec <- nvec
  212.             end if
  213.             index <- lastIndex + 1
  214.             if index >= maxSize then
  215.               index <- index - maxSize
  216.             end if
  217.             vec(index) := e
  218.             lastIndex <- index
  219.             currentSize <- currentSize + 1
  220.             upb <- upb + 1
  221.           end addUpper
  222.  
  223.           % return the element indexed by upb, after contracting 
  224.           % the set of valid indicies to lwb <= i <= upb - 1.
  225.           operation removeUpper -> [r : ElementType]
  226.             assert currentSize > 0
  227.             r <- vec(lastIndex)
  228.             currentSize <- currentSize - 1
  229.             upb <- upb - 1
  230.             if currentSize = 0 then
  231.               firstIndex <- 0
  232.               lastIndex <- ~1
  233.             else
  234.               lastIndex <- lastIndex - 1
  235.               if lastIndex < 0 then
  236.             lastIndex <- lastIndex + maxSize
  237.               end if
  238.             end if
  239.           end removeUpper
  240.  
  241.           % extend the set of valid indicies, changing lwb to 
  242.           % lwb - 1, and setting
  243.           % the element indexed by the new lwb to be e.
  244.           operation addLower [e : ElementType]
  245.             var index : Integer
  246.             if currentSize = maxSize then
  247.               var nvec : ve
  248.               const nMaxSize : Integer == maxSize * 2
  249.               var oldIndex : Integer <- firstIndex
  250.               var newIndex : Integer <- 0
  251.               nvec <- ve.create[nMaxSize]
  252.               loop
  253.             exit when newIndex >= maxSize
  254.             nvec(newIndex) := vec(oldIndex)
  255.             newIndex <- newIndex + 1
  256.             oldIndex <- oldIndex + 1
  257.             if oldIndex >= maxSize then
  258.               oldIndex <- oldIndex - maxSize
  259.             end if
  260.               end loop
  261.               firstIndex <- 0
  262.               lastIndex <- maxSize - 1
  263.               maxSize <- nMaxSize
  264.               vec <- nvec
  265.             end if
  266.             index <- firstIndex - 1
  267.             if index < 0 then
  268.               index <- index + maxSize
  269.             end if
  270.             vec(index) := e
  271.             firstIndex <- index
  272.             currentSize <- currentSize + 1
  273.             lwb <- lwb - 1
  274.           end addLower
  275.  
  276.           % return the element indexed by lwb, after contracting 
  277.           % the set of valid indicies to lwb + 1 <= i <= upb.
  278.           operation removeLower -> [r : ElementType]
  279.             assert currentSize > 0
  280.             r <- vec(firstIndex)
  281.             currentSize <- currentSize - 1
  282.             lwb <- lwb + 1
  283.             if currentSize = 0 then
  284.               firstIndex <- 0
  285.               lastIndex <- ~1
  286.             else 
  287.               firstIndex <- firstIndex + 1
  288.               if firstIndex >= maxSize then
  289.             firstIndex <- firstIndex - maxSize
  290.               end if
  291.             end if
  292.           end removeLower
  293.  
  294.           % -> true if the array is empty
  295.           function  empty -> [r : Boolean]
  296.             r <- currentSize = 0
  297.           end empty
  298.  
  299.           % return a new array the result of catenating the 
  300.           % elements of a to self
  301.           operation catenate [a : RIS] -> [catenateResult : NA]
  302.             var index, limit, newsize : Integer
  303.             var i : Integer <- 0
  304.             newsize <- currentSize+a.upperbound-a.lowerbound+1
  305.             catenateResult <- aNAT.create[newsize]
  306.             catenateResult.slideTo[lwb]
  307.             index <- firstIndex
  308.             loop
  309.               exit when i >= currentSize
  310.               catenateResult.addUpper[vec(index)]
  311.               i <- i + 1
  312.               index <- index + 1
  313.               if index >= maxSize then
  314.             index <- index - maxSize
  315.               end if
  316.             end loop
  317.             i <- a.lowerbound
  318.             limit <- a.upperbound
  319.             loop
  320.               exit when i > limit
  321.               catenateResult.addUpper[a(i)]
  322.               i <- i + 1
  323.             end loop
  324.           end catenate
  325.  
  326.           initially
  327.             lwb <- 0
  328.             firstIndex <- 0
  329.             if length < 0 then
  330.               upb <- ~1
  331.               lastIndex <- ~1
  332.               maxSize <- ~length
  333.               currentSize <- 0
  334.             elseif length = 0 then
  335.               upb <- ~1
  336.               lastIndex <- ~1
  337.               maxSize <- 10
  338.               currentSize <- 0
  339.             else
  340.               upb <- length - 1
  341.               lastIndex <- length - 1
  342.               maxSize <- length
  343.               currentSize <- length
  344.             end if
  345.             vec <- ve.create[maxSize]
  346.           end initially
  347.         end monitor
  348.           end aNA
  349.       end create
  350.       operation empty -> [result : NA]
  351.         result <- aNAT.create[0]
  352.       end empty
  353.       operation literal [v : RIS] -> [literalResult : NA]
  354.         var i : Integer <- v.lowerbound
  355.         const limit : Integer == v.upperbound
  356.         literalResult <- aNAT.create[~(limit - i + 1)]
  357.         loop
  358.           exit when i > limit
  359.           literalResult.addUpper[v(i)]
  360.           i <- i + 1
  361.         end loop
  362.       end literal
  363.     end aNAT
  364.     end of
  365.   end _ArrayObject
  366.