src/HOL/Codatatype/Tools/bnf_fp_sugar.ML
author blanchet
Tue, 04 Sep 2012 13:02:26 +0200
changeset 49112 4de4635d8f93
child 49119 1f605c36869c
permissions -rw-r--r--
started work on sugared "(co)data" commands
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
49112
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
     1
(*  Title:      HOL/Codatatype/Tools/bnf_fp_sugar.ML
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
     2
    Author:     Jasmin Blanchette, TU Muenchen
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
     3
    Copyright   2012
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
     4
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
     5
Sugar for constructing LFPs and GFPs.
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
     6
*)
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
     7
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
     8
signature BNF_FP_SUGAR =
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
     9
sig
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
    10
end;
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
    11
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
    12
structure BNF_FP_Sugar : BNF_FP_SUGAR =
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
    13
struct
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
    14
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
    15
fun data_cmd gfp specs lthy =
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
    16
  let
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
    17
  in
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
    18
    lthy
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
    19
  end;
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
    20
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
    21
val parse_ctr_arg =
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
    22
  Parse.$$$ "(" |-- Scan.option Parse.binding --| Parse.$$$ ":" -- Parse.typ --| Parse.$$$ ")" ||
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
    23
  (Parse.typ >> pair NONE);
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
    24
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
    25
val parse_single_spec =
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
    26
  Parse.type_args_constrained -- Parse.binding -- Parse.opt_mixfix --
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
    27
  (@{keyword "="} |-- Parse.enum1 "|" (Parse.binding -- Scan.repeat parse_ctr_arg --
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
    28
     Parse.opt_mixfix))
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
    29
  >> (fn (((vs, t), mx), cons) => ((t, vs, mx), map Parse.triple1 cons));
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
    30
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
    31
val _ =
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
    32
  Outer_Syntax.local_theory @{command_spec "data"} "define BNF-based inductive datatypes"
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
    33
    (Parse.and_list1 parse_single_spec >> data_cmd false);
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
    34
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
    35
val _ =
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
    36
  Outer_Syntax.local_theory @{command_spec "codata"} "define BNF-based coinductive datatypes"
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
    37
    (Parse.and_list1 parse_single_spec >> data_cmd true);
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
    38
4de4635d8f93 started work on sugared "(co)data" commands
blanchet
parents:
diff changeset
    39
end;