src/HOL/Tools/numeral_syntax.ML
author webertj
Wed, 30 Aug 2006 16:27:53 +0200
changeset 20440 e6fe74eebda3
parent 20094 99f27df2b6d0
child 21763 12a2773e3608
permissions -rw-r--r--
faster clause representation (again): full CNF formula as a hypothesis, instead of separate clauses
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
6905
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
     1
(*  Title:      HOL/Tools/numeral_syntax.ML
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
     2
    ID:         $Id$
20067
26bac504ef90 hex and binary numerals (contributed by Rafal Kolanski)
kleing
parents: 19481
diff changeset
     3
    Authors:    Markus Wenzel, TU Muenchen
6905
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
     4
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
     5
Concrete syntax for generic numerals.  Assumes consts and syntax of
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
     6
theory HOL/Numeral.
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
     7
*)
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
     8
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
     9
signature NUMERAL_SYNTAX =
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    10
sig
18708
4b3dadb4fe33 setup: theory -> theory;
wenzelm
parents: 16365
diff changeset
    11
  val setup: theory -> theory
6905
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    12
end;
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    13
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    14
structure NumeralSyntax: NUMERAL_SYNTAX =
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    15
struct
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    16
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    17
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    18
(* bit strings *)   (*we try to handle superfluous leading digits nicely*)
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    19
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    20
fun prefix_len _ [] = 0
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    21
  | prefix_len pred (x :: xs) =
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    22
      if pred x then 1 + prefix_len pred xs else 0;
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    23
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    24
fun dest_bin_str tm =
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    25
  let
15620
8ccdc8bc66a2 replaced bool by a new datatype "bit" for binary numerals
paulson
parents: 15595
diff changeset
    26
    val rev_digs = HOLogic.bin_of tm handle TERM _ => raise Match
6905
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    27
    val (sign, zs) =
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    28
      (case rev rev_digs of
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    29
        ~1 :: bs => ("-", prefix_len (equal 1) bs)
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    30
      | bs => ("", prefix_len (equal 0) bs));
15965
f422f8283491 Use of IntInf.int instead of int in most numeric simprocs; avoids
paulson
parents: 15620
diff changeset
    31
    val i = HOLogic.int_of rev_digs;
15595
dc8a41c7cefc fix integer overflow in numeral syntax for SML NJ.
obua
parents: 15013
diff changeset
    32
    val num = IntInf.toString (IntInf.abs i);
11701
3d51fbf81c17 sane numerals (stage 1): added generic 1, removed 1' and 2 on nat,
wenzelm
parents: 11488
diff changeset
    33
  in
15595
dc8a41c7cefc fix integer overflow in numeral syntax for SML NJ.
obua
parents: 15013
diff changeset
    34
    if i = IntInf.fromInt 0 orelse i = IntInf.fromInt 1 then raise Match
11701
3d51fbf81c17 sane numerals (stage 1): added generic 1, removed 1' and 2 on nat,
wenzelm
parents: 11488
diff changeset
    35
    else sign ^ implode (replicate zs "0") ^ num
3d51fbf81c17 sane numerals (stage 1): added generic 1, removed 1' and 2 on nat,
wenzelm
parents: 11488
diff changeset
    36
  end;
6905
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    37
20094
99f27df2b6d0 removed str_to_int in favour of general Syntax.read_xnum;
wenzelm
parents: 20067
diff changeset
    38
6905
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    39
(* translation of integer numeral tokens to and from bitstrings *)
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    40
11488
4ff900551340 constify numeral tokens in order to allow translations;
wenzelm
parents: 10891
diff changeset
    41
fun numeral_tr (*"_Numeral"*) [t as Const (str, _)] =
20094
99f27df2b6d0 removed str_to_int in favour of general Syntax.read_xnum;
wenzelm
parents: 20067
diff changeset
    42
      (Syntax.const "Numeral.number_of" $ (HOLogic.mk_binum (Syntax.read_xnum str)))
6905
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    43
  | numeral_tr (*"_Numeral"*) ts = raise TERM ("numeral_tr", ts);
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    44
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    45
fun numeral_tr' show_sorts (*"number_of"*) (Type ("fun", [_, T])) (t :: ts) =
11488
4ff900551340 constify numeral tokens in order to allow translations;
wenzelm
parents: 10891
diff changeset
    46
      let val t' = Syntax.const "_Numeral" $ Syntax.free (dest_bin_str t) in
7429
8f284fbb8728 observe show_types;
wenzelm
parents: 7078
diff changeset
    47
        if not (! show_types) andalso can Term.dest_Type T then t'
6905
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    48
        else Syntax.const Syntax.constrainC $ t' $ Syntax.term_of_typ show_sorts T
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    49
      end
13110
ca8cd110f769 be liberal about missing types;
wenzelm
parents: 11701
diff changeset
    50
  | numeral_tr' _ (*"number_of"*) T (t :: ts) =
ca8cd110f769 be liberal about missing types;
wenzelm
parents: 11701
diff changeset
    51
      if T = dummyT then Syntax.const "_Numeral" $ Syntax.free (dest_bin_str t)
ca8cd110f769 be liberal about missing types;
wenzelm
parents: 11701
diff changeset
    52
      else raise Match
6905
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    53
  | numeral_tr' _ (*"number_of"*) _ _ = raise Match;
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    54
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    55
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    56
(* theory setup *)
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    57
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    58
val setup =
18708
4b3dadb4fe33 setup: theory -> theory;
wenzelm
parents: 16365
diff changeset
    59
  Theory.add_trfuns ([], [("_Numeral", numeral_tr)], [], []) #>
4b3dadb4fe33 setup: theory -> theory;
wenzelm
parents: 16365
diff changeset
    60
  Theory.add_trfunsT [("number_of", numeral_tr'), ("Numeral.number_of", numeral_tr')];
6905
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    61
9bc05ec3497b added Numeral.thy, Tools/numeral_syntax.ML;
wenzelm
parents:
diff changeset
    62
end;