home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / ipl / packs / skeem / llist.icn next >
Text File  |  2000-07-29  |  3KB  |  175 lines
  1. ############################################################################
  2. #
  3. #    Name:    llist.icn
  4. #
  5. #    Title:    Linked-list utilities, Lisp-style
  6. #
  7. #    Author: Bob Alexander
  8. #
  9. #    Date:    February 19, 1995
  10. #
  11. ############################################################################
  12.  
  13. #
  14. # Procedure kit supporting operations on linked lists, Lisp-style.
  15. #
  16.  
  17. global LLNull
  18.  
  19. record LLPair(first,rest)
  20.  
  21. #
  22. # Basic list operations.
  23. #
  24.  
  25. procedure LLFirst(x)
  26.    return (\x).first
  27. end
  28.  
  29. procedure LLRest(x)
  30.    return (\x).rest
  31. end
  32.  
  33.  
  34. #
  35. # Predicates -- the predicates fail if false, and return their arguments if
  36. # true.  Note that the returned value for the true condition might be null.
  37. #
  38.  
  39. procedure LLIsNull(x)
  40.    return /x
  41. end
  42.  
  43. procedure LLIsPair(x)
  44.    return (type(x) == "LLPair",x)
  45. end
  46.  
  47. procedure LLIsNotPair(x)
  48.    return (type(x) ~== "LLPair",x)
  49. end
  50.  
  51. procedure LLIsList(x)
  52.    return (LLIsNull | LLIsPair)(x)
  53. end
  54.  
  55. procedure LLIsNotList(x)
  56.    return (not (LLIsNull | LLIsPair)(x),x)
  57. end
  58.  
  59.  
  60. #
  61. # More list operations.
  62. #
  63.  
  64. procedure LList(x[])
  65.    local ll
  66.    every ll := LLPair(!x,ll)
  67.    return LLInvert(ll)
  68. end
  69.  
  70. procedure LLToList(ll)
  71.    local result
  72.    result := []
  73.    every put(result,LLElements(ll))
  74.    return result
  75. end
  76.  
  77. procedure LLAppend(ll[])
  78.    local result
  79.    every result := LLPair(LLElements(ll[1 to *ll - 1]),result)
  80.    return LLInvert(result,ll[-1] | &null)
  81. end
  82.  
  83. procedure LLSplice(ll[])
  84.    local result,x,prev
  85.    every x := !ll do {
  86.       result := \x
  87.       (\prev).rest := x
  88.       prev := LLLastPair(x)
  89.       }
  90.    return result
  91. end
  92.  
  93. procedure LLLastPair(ll)
  94.    local result
  95.    every result := LLPairs(ll)
  96.    return \result
  97. end
  98.  
  99. procedure LLPut(ll,x)
  100.    return ((\LLLastPair(ll)).rest := LLPair(x),ll) | LLPair(x)
  101. end
  102.  
  103. procedure LLInvert(ll,dot)
  104.    local nxt
  105.    while \ll do {
  106.       nxt := ll.rest
  107.       ll.rest := dot
  108.       dot := ll
  109.       ll := nxt
  110.       }
  111.    return dot
  112. end
  113.  
  114. procedure LLReverse(ll)
  115.    local new_list
  116.    every new_list := LLPair(LLElements(ll),new_list)
  117.    return new_list
  118. end
  119.  
  120. procedure LLElements(ll)
  121.    while LLIsPair(ll) do {
  122.       suspend ll.first
  123.       ll := ll.rest
  124.       }
  125. end
  126.  
  127. procedure LLPairs(ll)
  128.    while LLIsPair(ll) do {
  129.       suspend ll
  130.       ll := ll.rest
  131.       }
  132. end
  133.  
  134. procedure LLSecond(ll)
  135.    return (\(\ll).rest).first
  136. end
  137.  
  138. procedure LLThird(ll)
  139.    return LLElement(ll,3)
  140. end
  141.  
  142. procedure LLElement(ll,i)
  143.    return LLTail(ll,i).first
  144. end
  145.  
  146. procedure LLTail(ll,i)
  147.    return 1(LLPairs(ll),(i -:= 1) = 0)
  148. end
  149.  
  150. procedure LLCopy(ll)
  151.    return LLInvert(LLReverse(ll))
  152. end
  153.  
  154. procedure LLLength(ll)
  155.    local result
  156.    result := 0
  157.    every LLPairs(ll) do result +:= 1
  158.    return result
  159. end
  160.  
  161. procedure LLImage(x)
  162.    local result,pair
  163.    return {
  164.       if /x then "()"
  165.       else if LLIsPair(x) then {
  166.      result := "("
  167.      every pair := LLPairs(x) do
  168.         result ||:= LLImage(pair.first) || " "
  169.      if /pair.rest then result[1:-1] || ")"
  170.      else result || ". " || LLImage(pair.rest) || ")"
  171.      }
  172.       else image(x)
  173.       }
  174. end
  175.