6 *) |
6 *) |
7 |
7 |
8 structure Function_Lib = (* FIXME proper signature *) |
8 structure Function_Lib = (* FIXME proper signature *) |
9 struct |
9 struct |
10 |
10 |
11 fun map_option f NONE = NONE |
11 (* "The variable" ^ plural " is" "s are" vs *) |
12 | map_option f (SOME x) = SOME (f x); |
|
13 |
|
14 fun fold_option f NONE y = y |
|
15 | fold_option f (SOME x) y = f x y; |
|
16 |
|
17 (* Ex: "The variable" ^ plural " is" "s are" vs *) |
|
18 fun plural sg pl [x] = sg |
12 fun plural sg pl [x] = sg |
19 | plural sg pl _ = pl |
13 | plural sg pl _ = pl |
20 |
|
21 fun dest_all (Const ("all", _) $ Abs (a as (_,T,_))) = |
|
22 let |
|
23 val (n, body) = Term.dest_abs a |
|
24 in |
|
25 (Free (n, T), body) |
|
26 end |
|
27 | dest_all _ = raise Match |
|
28 |
14 |
29 |
15 |
30 (* Removes all quantifiers from a term, replacing bound variables by frees. *) |
16 (* Removes all quantifiers from a term, replacing bound variables by frees. *) |
31 fun dest_all_all (t as (Const ("all",_) $ _)) = |
17 fun dest_all_all (t as (Const ("all",_) $ _)) = |
32 let |
18 let |
33 val (v,b) = dest_all t |
19 val (v,b) = Logic.dest_all t |> apfst Free |
34 val (vs, b') = dest_all_all b |
20 val (vs, b') = dest_all_all b |
35 in |
21 in |
36 (v :: vs, b') |
22 (v :: vs, b') |
37 end |
23 end |
38 | dest_all_all t = ([],t) |
24 | dest_all_all t = ([],t) |
54 end |
40 end |
55 | dest_all_all_ctx ctx t = |
41 | dest_all_all_ctx ctx t = |
56 (ctx, [], t) |
42 (ctx, [], t) |
57 |
43 |
58 |
44 |
59 fun map3 _ [] [] [] = [] |
|
60 | map3 f (x :: xs) (y :: ys) (z :: zs) = f x y z :: map3 f xs ys zs |
|
61 | map3 _ _ _ _ = raise Library.UnequalLengths; |
|
62 |
|
63 fun map4 _ [] [] [] [] = [] |
45 fun map4 _ [] [] [] [] = [] |
64 | map4 f (x :: xs) (y :: ys) (z :: zs) (u :: us) = f x y z u :: map4 f xs ys zs us |
46 | map4 f (x :: xs) (y :: ys) (z :: zs) (u :: us) = f x y z u :: map4 f xs ys zs us |
65 | map4 _ _ _ _ _ = raise Library.UnequalLengths; |
47 | map4 _ _ _ _ _ = raise Library.UnequalLengths; |
66 |
|
67 fun map6 _ [] [] [] [] [] [] = [] |
|
68 | map6 f (x :: xs) (y :: ys) (z :: zs) (u :: us) (v :: vs) (w :: ws) = f x y z u v w :: map6 f xs ys zs us vs ws |
|
69 | map6 _ _ _ _ _ _ _ = raise Library.UnequalLengths; |
|
70 |
48 |
71 fun map7 _ [] [] [] [] [] [] [] = [] |
49 fun map7 _ [] [] [] [] [] [] [] = [] |
72 | map7 f (x :: xs) (y :: ys) (z :: zs) (u :: us) (v :: vs) (w :: ws) (b :: bs) = f x y z u v w b :: map7 f xs ys zs us vs ws bs |
50 | map7 f (x :: xs) (y :: ys) (z :: zs) (u :: us) (v :: vs) (w :: ws) (b :: bs) = f x y z u v w b :: map7 f xs ys zs us vs ws bs |
73 | map7 _ _ _ _ _ _ _ _ = raise Library.UnequalLengths; |
51 | map7 _ _ _ _ _ _ _ _ = raise Library.UnequalLengths; |
74 |
52 |