home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Environments / Clean 1.2.4 / IO Examples / Simple DataBase / listextensions.icl < prev   
Encoding:
Modula Implementation  |  1997-04-24  |  1.5 KB  |  41 lines  |  [TEXT/3PRM]
  1. implementation module listextensions
  2.  
  3. import    StdInt, StdBool, StdString, StdList, StdMisc
  4.  
  5. insertAt :: !Int .a u:[.a] -> v:[.a], [u <= v]
  6. insertAt i x ys = before ++ [ x : at ]                                     where (before,at) = splitAt i ys
  7.     
  8. updateAt :: !Int .a [.a] -> [.a]
  9. updateAt i x ys = before ++ [ x : case at of [] -> []; [r:rs] -> rs ]    where (before,at) = splitAt i ys
  10.  
  11. insertindex :: !(a -> a -> Bool) !a !u:[a] -> (!Int,!v:[a]), [u <= v]
  12. insertindex r x ls = inserti r 0 x ls
  13. where
  14.     inserti :: !(a -> .(a -> .Bool)) !Int !a !u:[a] -> (!Int,!v:[a]), [u <= v]
  15.     inserti r i x ls=:[y:ys]
  16.     |    r x y        = (    i,[x:ls])
  17.     |    otherwise    = (index,[y:list]) with (index,list) = inserti r (inc i) x ys
  18.     inserti _ i x _    = (    i,[x])
  19.  
  20. removeindex :: !a !u:[a] -> (!Int,!v:[a]) | ==, toString a, [u <= v]
  21. removeindex e xs = removei e xs 0
  22. where
  23.     removei :: !a !u:[a] !Int -> (!Int,v:[a]) | ==, toString a, [u <= v]
  24.     removei e [x:xs] i
  25.     |    x==e        = (i,xs)
  26.     |    otherwise    = (j,[x:res]) with (j,res) = removei e xs (inc i)
  27.     removei e _ _    = abort ("Err: "+++toString e+++" not removable!")
  28.  
  29. moveinlist :: !Int !Int !.[a] -> [a]
  30. moveinlist src dest l                // should be in StdList
  31. |    src < dest    = remove src beforedest ++ [l!!src : atdest]
  32. |    src > dest    = beforedest ++ [l!!src : remove (src - dest) atdest]
  33. |    otherwise    = l
  34. where
  35.     (beforedest,atdest)    = splitAt dest l    
  36.  
  37. splitby :: a !.[a] -> [.[a]] | == a
  38. splitby x ys            = case rest of [] -> [firstpart]; [r:rs] -> [firstpart:splitby x rs]
  39. where
  40.     (firstpart,rest)    = span ((<>) x) ys
  41.