home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / compiler / Fnlib.sml < prev    next >
Encoding:
Text File  |  1997-08-18  |  2.3 KB  |  104 lines  |  [TEXT/R*ch]
  1. (* Fnlib.sml. Library functions *)
  2.  
  3. exception Impossible of string;
  4.  
  5. fun fatalError s = raise(Impossible s);
  6.  
  7. fun getOption NONE = fatalError "getOption"
  8.   | getOption (SOME a) = a
  9. ;
  10.  
  11. fun fst (x, y) = x;
  12. fun snd (x, y) = y;
  13.  
  14. fun incr r = r := !r + 1;
  15. fun decr r = r := !r - 1;
  16.  
  17. fun mapFrom f n [] = []
  18.   | mapFrom f n (x :: xs) = f n x :: mapFrom f (n+1) xs
  19. ;
  20.  
  21. fun map2 f [] [] = []
  22.   | map2 f (x :: xs) (y :: ys) = f x y :: map2 f xs ys
  23.   | map2 f _ _ = fatalError "map2: lists of different length"
  24. ;
  25.  
  26. fun appFrom f n [] = ()
  27.   | appFrom f n (x :: xs) = (f n x : unit; appFrom f (n+1) xs)
  28. ;
  29.  
  30. fun app2 f [] [] = ()
  31.   | app2 f (x::xs) (y::ys) = (f x y : unit; app2 f xs ys)
  32.   | app2 f _ _ = fatalError "app2: lists of different length"
  33. ;
  34.  
  35. fun foldL f a [] = a
  36.   | foldL f a (x::xs) = foldL f (f x a) xs
  37. ;
  38.  
  39. fun foldL_zip f a [] [] = a
  40.   | foldL_zip f a (x::xs) (y::ys) = foldL_zip f (f x y a) xs ys
  41.   | foldL_zip f a _ _ = fatalError "foldL_zip: lists of different length"
  42. ;
  43.  
  44. fun foldL_map f g a [] = a
  45.   | foldL_map f g a (x::xs) = foldL_map f g (f (g x) a) xs
  46. ;
  47.  
  48. fun foldR f a [] = a
  49.   | foldR f a (x::xs) = f x (foldR f a xs)
  50. ;
  51.  
  52. fun foldR1 f [] = fatalError "foldR1: an empty argument"
  53.   | foldR1 f [x]   = x
  54.   | foldR1 f (x::xs) = f x (foldR1 f xs)
  55. ;
  56.  
  57. fun foldR_map f g e [] = e
  58.   | foldR_map f g e (x::xs) = f (g x) (foldR_map f g e xs)
  59. ;
  60.  
  61. fun map_fields f [] = []
  62.   | map_fields f ((lab, t) :: xs) = (lab, f t) :: map_fields f xs
  63. ;
  64.  
  65. fun all_fields f [] = true
  66.   | all_fields f ((_, t) :: xs) =
  67.       (f t) andalso all_fields f xs
  68. ;
  69.  
  70. fun exists_field f [] = false
  71.   | exists_field f ((_, t) :: xs) =
  72.       (f t) orelse exists_field f xs
  73. ;
  74.  
  75. fun app_field f [] = ()
  76.   | app_field f ((_, t) :: xs) = (f t : unit; app_field f xs)
  77. ;
  78.  
  79. fun member k [] = false
  80.   | member k (x :: xs) =
  81.     if k = x then true else member k xs
  82. ;
  83.  
  84. fun lookup k [] = raise Subscript
  85.   | lookup k ((a, v) :: xs) =
  86.     if k = a then v else lookup k xs
  87. ;
  88.  
  89. fun duplicates [] = false
  90.   | duplicates (x :: xs) = member x xs orelse duplicates xs
  91. ;
  92. fun stringToLower s =
  93.     CharVector.tabulate(size s, fn i => Char.toLower(CharVector.sub(s, i)));
  94.  
  95. fun for f i j =
  96.   if i > j then () else (f i : unit; for f (i+1) j)
  97. ;
  98.  
  99. fun zip2 [] [] = []
  100.   | zip2 [] (y :: ys) = fatalError "zip2"
  101.   | zip2 (x :: xs) [] = fatalError "zip2"
  102.   | zip2 (x :: xs) (y :: ys) = (x, y) :: zip2 xs ys
  103. ;
  104.