1(* -------------------------------------------------------------------------
2   L3
3   ------------------------------------------------------------------------- *)
4
5structure L3 :> L3 =
6struct
7
8   fun fst (x, _) = x
9   fun snd (_, x) = x
10   fun K x _ = x
11   fun uncurry f (x,y) = f x y
12   fun equal x y = (x = y)
13
14   val lowercase = String.map Char.toLower
15   val uppercase = String.map Char.toUpper
16
17   fun prefix (c, s) = String.str c ^ s
18   fun strHd s = String.sub (s, 0)
19   fun strTl s = String.extract (s, 1, NONE)
20
21   fun update m i e = fn x => if x = i then e else m x
22
23   fun for (i, j, a) =
24      ( a i
25      ; if i = j
26           then ()
27        else for (if Nat.< (i, j) then Nat.suc i else Nat.pred i, j, a)
28      )
29
30   fun foreach ([], _) = ()
31     | foreach (h :: t, a) = (a h; foreach (t, a))
32
33   fun pairCompare (cmp1, cmp2) ((a: 'a, b: 'b), (c: 'a, d :'b)) =
34      case cmp1 (a, c) of
35         General.EQUAL => cmp2 (b, d)
36       | x => x
37
38   fun listCompare cmp =
39      let
40         fun compare ([], _) = General.EQUAL
41           | compare (_, []) = raise Fail "list_compare"
42           | compare (h1 :: t1, h2 :: t2) =
43                case cmp (h1, h2) of
44                   General.EQUAL => compare (t1, t2)
45                 | x => x
46      in
47         fn (l1, l2) =>
48            pairCompare (Int.compare, compare)
49               ((List.length l1, l1), (List.length l2, l2))
50      end
51
52   local
53      fun liftSubstring (f, s) =
54         let
55            val (a, b) = f (Substring.full s)
56         in
57            (Substring.string a, Substring.string b)
58         end
59   in
60      fun splitl (p, s) = liftSubstring (Substring.splitl p, s)
61      fun splitr (p, s) = liftSubstring (Substring.splitr p, s)
62   end
63
64   fun listUpdate (e, (i, [])) = []
65     | listUpdate (e, (0: IntInf.int, _::l)) = e :: l
66     | listUpdate (e, (n, h::l)) = h :: listUpdate (e, (n - 1, l))
67
68   val chr = Char.chr o IntInf.toInt
69   val ord = IntInf.fromInt o Char.ord
70   local
71     fun sz (n, l) =
72       Nat.toNativeInt (Nat.- (n, Nat.fromNativeInt (List.length l)))
73   in
74     fun padLeft (e, x as (_, l)) = List.tabulate (sz x, fn _ => e) @ l
75     fun padRight (e, x as (_, l)) = l @ List.tabulate (sz x, fn _ => e)
76   end
77   fun padLeftString (e, (n, l)) = StringCvt.padLeft e (IntInf.toInt n) l
78   fun padRightString (e, (n, l)) = StringCvt.padRight e (IntInf.toInt n) l
79   fun takeString (n, s) = String.extract (s, 0, SOME (IntInf.toInt n))
80   fun dropString (n, s) = String.extract (s, IntInf.toInt n, NONE)
81   val removeDuplicatesString = String.implode o Set.mk o String.explode
82   val revString = String.implode o List.rev o String.explode
83   fun stringToChar s =
84      if String.size s = 1 then String.sub (s, 0) else raise Domain
85   fun memString (c, s) = String.isSubstring (String.str c) s
86   fun stringUpdate (e, (i, s)) =
87      String.implode (listUpdate (e, (i, String.explode s)))
88
89   local
90      fun trans P (s, r) =
91         String.translate
92            (fn d => let val x = String.str d in if P x r then "" else x end) s
93   in
94      val removeExceptString =
95         trans (fn x => fn r => not (String.isSubstring x r))
96      val removeString = trans String.isSubstring
97   end
98
99   fun revLookup eq (e, l) =
100      let
101         fun loop i =
102            fn [] => NONE
103             | h :: t => if eq e h then SOME i else loop (i + 1) t
104      in
105         loop (0: IntInf.int) l
106      end
107
108   fun remove (l1, l2) = List.filter (fn x => not (Set.mem (x, l2))) l1
109   fun swap (n, l) = (l, n)
110   fun take (n, l) = List.take (l, IntInf.toInt n)
111   fun drop (n, l) = List.drop (l, IntInf.toInt n)
112   fun element (n, l) = List.nth (l, IntInf.toInt n)
113   fun indexOf x = revLookup equal x
114   fun indexOfString (c, s) = revLookup equal (c, String.explode s)
115   fun length l = IntInf.fromInt (List.length l)
116   val size = IntInf.fromInt o String.size
117
118end (* structure L3 *)
119