| author | paulson | 
| Mon, 07 Sep 2009 13:19:09 +0100 | |
| changeset 32532 | a0a54a51b15b | 
| parent 31853 | f079b174e56a | 
| child 33770 | 1ef05f838d51 | 
| permissions | -rw-r--r-- | 
| 28308 | 1 | (* Title: HOL/Tools/dseq.ML | 
| 24625 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 2 | Author: Stefan Berghofer, TU Muenchen | 
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 3 | |
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 4 | Sequences with recursion depth limit. | 
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 5 | *) | 
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 6 | |
| 25308 | 7 | signature DSEQ = | 
| 8 | sig | |
| 9 | type 'a seq = int -> 'a Seq.seq; | |
| 10 |   val maps: ('a -> 'b seq) -> 'a seq -> 'b seq
 | |
| 11 |   val map: ('a -> 'b) -> 'a seq -> 'b seq
 | |
| 12 | val append: 'a seq -> 'a seq -> 'a seq | |
| 13 | val interleave: 'a seq -> 'a seq -> 'a seq | |
| 14 | val single: 'a -> 'a seq | |
| 15 | val empty: 'a seq | |
| 16 | val guard: bool -> unit seq | |
| 17 | val of_list: 'a list -> 'a seq | |
| 18 | val list_of: 'a seq -> 'a list | |
| 19 |   val pull: 'a seq -> ('a * 'a seq) option
 | |
| 20 | val hd: 'a seq -> 'a | |
| 21 | end; | |
| 22 | ||
| 23 | structure DSeq : DSEQ = | |
| 24625 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 24 | struct | 
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 25 | |
| 25308 | 26 | type 'a seq = int -> 'a Seq.seq; | 
| 27 | ||
| 24625 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 28 | fun maps f s 0 = Seq.empty | 
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 29 | | maps f s i = Seq.maps (fn a => f a i) (s (i - 1)); | 
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 30 | |
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 31 | fun map f s i = Seq.map f (s i); | 
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 32 | |
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 33 | fun append s1 s2 i = Seq.append (s1 i) (s2 i); | 
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 34 | |
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 35 | fun interleave s1 s2 i = Seq.interleave (s1 i, s2 i); | 
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 36 | |
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 37 | fun single x i = Seq.single x; | 
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 38 | |
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 39 | fun empty i = Seq.empty; | 
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 40 | |
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 41 | fun guard b = if b then single () else empty; | 
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 42 | |
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 43 | fun of_list xs i = Seq.of_list xs; | 
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 44 | |
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 45 | fun list_of s = Seq.list_of (s ~1); | 
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 46 | |
| 25308 | 47 | fun pull s = Seq.pull (s ~1) |> (Option.map o apsnd) K; (*FIXME*) | 
| 24625 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 48 | |
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 49 | fun hd s = Seq.hd (s ~1); | 
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 50 | |
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 51 | end; | 
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 52 | |
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 53 | |
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 54 | (* combinators for code generated from inductive predicates *) | 
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 55 | |
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 56 | infix 5 :->; | 
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 57 | infix 3 ++; | 
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 58 | |
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 59 | fun s :-> f = DSeq.maps f s; | 
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 60 | |
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 61 | fun f ++ g = DSeq.append f g; | 
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 62 | |
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 63 | val ?? = DSeq.guard; | 
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 64 | |
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 65 | fun ??? f g = f o g; | 
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 66 | |
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 67 | fun ?! s = is_some (DSeq.pull s); | 
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 68 | |
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 69 | fun equal__1 x = DSeq.single x; | 
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 70 | |
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 71 | val equal__2 = equal__1; | 
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 72 | |
| 
0398a5e802d3
separated code for inductive sequences from inductive_codegen.ML
 haftmann parents: diff
changeset | 73 | fun equal__1_2 (x, y) = ?? (x = y); |