src/HOL/Tools/dseq.ML
author haftmann
Mon, 29 Jun 2009 12:18:58 +0200
changeset 31853 f079b174e56a
parent 28308 d4396a28fb29
child 33770 1ef05f838d51
permissions -rw-r--r--
dropped Id
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
28308
d4396a28fb29 fixed headers
haftmann
parents: 25308
diff changeset
     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
fc01c83a466d added explicit signature
haftmann
parents: 24625
diff changeset
     7
signature DSEQ =
fc01c83a466d added explicit signature
haftmann
parents: 24625
diff changeset
     8
sig
fc01c83a466d added explicit signature
haftmann
parents: 24625
diff changeset
     9
  type 'a seq = int -> 'a Seq.seq;
fc01c83a466d added explicit signature
haftmann
parents: 24625
diff changeset
    10
  val maps: ('a -> 'b seq) -> 'a seq -> 'b seq
fc01c83a466d added explicit signature
haftmann
parents: 24625
diff changeset
    11
  val map: ('a -> 'b) -> 'a seq -> 'b seq
fc01c83a466d added explicit signature
haftmann
parents: 24625
diff changeset
    12
  val append: 'a seq -> 'a seq -> 'a seq
fc01c83a466d added explicit signature
haftmann
parents: 24625
diff changeset
    13
  val interleave: 'a seq -> 'a seq -> 'a seq
fc01c83a466d added explicit signature
haftmann
parents: 24625
diff changeset
    14
  val single: 'a -> 'a seq
fc01c83a466d added explicit signature
haftmann
parents: 24625
diff changeset
    15
  val empty: 'a seq
fc01c83a466d added explicit signature
haftmann
parents: 24625
diff changeset
    16
  val guard: bool -> unit seq
fc01c83a466d added explicit signature
haftmann
parents: 24625
diff changeset
    17
  val of_list: 'a list -> 'a seq
fc01c83a466d added explicit signature
haftmann
parents: 24625
diff changeset
    18
  val list_of: 'a seq -> 'a list
fc01c83a466d added explicit signature
haftmann
parents: 24625
diff changeset
    19
  val pull: 'a seq -> ('a * 'a seq) option
fc01c83a466d added explicit signature
haftmann
parents: 24625
diff changeset
    20
  val hd: 'a seq -> 'a
fc01c83a466d added explicit signature
haftmann
parents: 24625
diff changeset
    21
end;
fc01c83a466d added explicit signature
haftmann
parents: 24625
diff changeset
    22
fc01c83a466d added explicit signature
haftmann
parents: 24625
diff changeset
    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
fc01c83a466d added explicit signature
haftmann
parents: 24625
diff changeset
    26
type 'a seq = int -> 'a Seq.seq;
fc01c83a466d added explicit signature
haftmann
parents: 24625
diff changeset
    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
fc01c83a466d added explicit signature
haftmann
parents: 24625
diff changeset
    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);