src/HOL/Library/Code_Char.thy
author wenzelm
Tue, 26 Mar 2013 20:02:02 +0100
changeset 51542 738598beeb26
parent 51160 599ff65b85e2
child 52435 6646bb548c6b
permissions -rw-r--r--
tuned imports;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
24999
haftmann
parents:
diff changeset
     1
(*  Title:      HOL/Library/Code_Char.thy
haftmann
parents:
diff changeset
     2
    Author:     Florian Haftmann
haftmann
parents:
diff changeset
     3
*)
haftmann
parents:
diff changeset
     4
haftmann
parents:
diff changeset
     5
header {* Code generation of pretty characters (and strings) *}
haftmann
parents:
diff changeset
     6
haftmann
parents:
diff changeset
     7
theory Code_Char
51542
738598beeb26 tuned imports;
wenzelm
parents: 51160
diff changeset
     8
imports Main Char_ord
24999
haftmann
parents:
diff changeset
     9
begin
haftmann
parents:
diff changeset
    10
haftmann
parents:
diff changeset
    11
code_type char
haftmann
parents:
diff changeset
    12
  (SML "char")
haftmann
parents:
diff changeset
    13
  (OCaml "char")
48431
6efff142bb54 restrict unqualified imports from Haskell Prelude to a small set of fundamental operations
haftmann
parents: 42598
diff changeset
    14
  (Haskell "Prelude.Char")
37222
4d984bc33c66 added Scala code setup
haftmann
parents: 33234
diff changeset
    15
  (Scala "Char")
24999
haftmann
parents:
diff changeset
    16
haftmann
parents:
diff changeset
    17
setup {*
37222
4d984bc33c66 added Scala code setup
haftmann
parents: 33234
diff changeset
    18
  fold String_Code.add_literal_char ["SML", "OCaml", "Haskell", "Scala"] 
31053
b7e1c065b6e4 confine term setup to Eval serialiser
haftmann
parents: 31046
diff changeset
    19
  #> String_Code.add_literal_list_string "Haskell"
24999
haftmann
parents:
diff changeset
    20
*}
haftmann
parents:
diff changeset
    21
38857
97775f3e8722 renamed class/constant eq to equal; tuned some instantiations
haftmann
parents: 37459
diff changeset
    22
code_instance char :: equal
24999
haftmann
parents:
diff changeset
    23
  (Haskell -)
haftmann
parents:
diff changeset
    24
haftmann
parents:
diff changeset
    25
code_reserved SML
haftmann
parents:
diff changeset
    26
  char
haftmann
parents:
diff changeset
    27
haftmann
parents:
diff changeset
    28
code_reserved OCaml
haftmann
parents:
diff changeset
    29
  char
haftmann
parents:
diff changeset
    30
37222
4d984bc33c66 added Scala code setup
haftmann
parents: 33234
diff changeset
    31
code_reserved Scala
4d984bc33c66 added Scala code setup
haftmann
parents: 33234
diff changeset
    32
  char
4d984bc33c66 added Scala code setup
haftmann
parents: 33234
diff changeset
    33
38857
97775f3e8722 renamed class/constant eq to equal; tuned some instantiations
haftmann
parents: 37459
diff changeset
    34
code_const "HOL.equal \<Colon> char \<Rightarrow> char \<Rightarrow> bool"
24999
haftmann
parents:
diff changeset
    35
  (SML "!((_ : char) = _)")
haftmann
parents:
diff changeset
    36
  (OCaml "!((_ : char) = _)")
39272
0b61951d2682 Haskell == is infix, not infixl
haftmann
parents: 39250
diff changeset
    37
  (Haskell infix 4 "==")
37222
4d984bc33c66 added Scala code setup
haftmann
parents: 33234
diff changeset
    38
  (Scala infixl 5 "==")
24999
haftmann
parents:
diff changeset
    39
32657
5f13912245ff Code_Eval(uation)
haftmann
parents: 31053
diff changeset
    40
code_const "Code_Evaluation.term_of \<Colon> char \<Rightarrow> term"
31046
c1969f609bf7 confine term setup to Eval serialiser
haftmann
parents: 30663
diff changeset
    41
  (Eval "HOLogic.mk'_char/ (IntInf.fromInt/ (Char.ord/ _))")
28228
7ebe8dc06cbb evaluation using code generator
haftmann
parents: 28090
diff changeset
    42
33234
a5eba0447559 added implode and explode
haftmann
parents: 32657
diff changeset
    43
a5eba0447559 added implode and explode
haftmann
parents: 32657
diff changeset
    44
definition implode :: "string \<Rightarrow> String.literal" where
a5eba0447559 added implode and explode
haftmann
parents: 32657
diff changeset
    45
  "implode = STR"
a5eba0447559 added implode and explode
haftmann
parents: 32657
diff changeset
    46
a5eba0447559 added implode and explode
haftmann
parents: 32657
diff changeset
    47
code_reserved SML String
a5eba0447559 added implode and explode
haftmann
parents: 32657
diff changeset
    48
a5eba0447559 added implode and explode
haftmann
parents: 32657
diff changeset
    49
code_const implode
a5eba0447559 added implode and explode
haftmann
parents: 32657
diff changeset
    50
  (SML "String.implode")
42598
85ca44488a29 adding code generation setup for String.implode and String.explode in OCaml (contributed by Andreas Lochbihler)
bulwahn
parents: 42316
diff changeset
    51
  (OCaml "!(let l = _ in let res = String.create (List.length l) in let rec imp i = function | [] -> res | c :: l -> String.set res i c; imp (i + 1) l in imp 0 l)")
33234
a5eba0447559 added implode and explode
haftmann
parents: 32657
diff changeset
    52
  (Haskell "_")
37459
7a3610dca96b avoid Scala legacy operations
haftmann
parents: 37222
diff changeset
    53
  (Scala "!(\"\" ++/ _)")
33234
a5eba0447559 added implode and explode
haftmann
parents: 32657
diff changeset
    54
a5eba0447559 added implode and explode
haftmann
parents: 32657
diff changeset
    55
code_const explode
a5eba0447559 added implode and explode
haftmann
parents: 32657
diff changeset
    56
  (SML "String.explode")
42598
85ca44488a29 adding code generation setup for String.implode and String.explode in OCaml (contributed by Andreas Lochbihler)
bulwahn
parents: 42316
diff changeset
    57
  (OCaml "!(let s = _ in let rec exp i l = if i < 0 then l else exp (i - 1) (String.get s i :: l) in exp (String.length s - 1) [])")
33234
a5eba0447559 added implode and explode
haftmann
parents: 32657
diff changeset
    58
  (Haskell "_")
37459
7a3610dca96b avoid Scala legacy operations
haftmann
parents: 37222
diff changeset
    59
  (Scala "!(_.toList)")
33234
a5eba0447559 added implode and explode
haftmann
parents: 32657
diff changeset
    60
51160
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    61
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    62
definition integer_of_char :: "char \<Rightarrow> integer"
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    63
where
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    64
  "integer_of_char = integer_of_nat o nat_of_char"
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    65
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    66
definition char_of_integer :: "integer \<Rightarrow> char"
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    67
where
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    68
  "char_of_integer = char_of_nat \<circ> nat_of_integer"
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    69
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    70
lemma [code]:
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    71
  "nat_of_char = nat_of_integer o integer_of_char"
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    72
  by (simp add: integer_of_char_def fun_eq_iff)
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    73
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    74
lemma [code]:
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    75
  "char_of_nat = char_of_integer o integer_of_nat"
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    76
  by (simp add: char_of_integer_def fun_eq_iff)
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    77
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    78
code_const integer_of_char and char_of_integer
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    79
  (SML "!(IntInf.fromInt o Char.ord)"
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    80
    and "!(Char.chr o IntInf.toInt)")
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    81
  (OCaml "Big'_int.big'_int'_of'_int (Char.code _)"
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    82
    and "Char.chr (Big'_int.int'_of'_big'_int _)")
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    83
  (Haskell "Prelude.toInteger (Prelude.fromEnum (_ :: Prelude.Char))"
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    84
    and "!(let chr k | (0 <= k && k < 256) = Prelude.toEnum k :: Prelude.Char in chr . Prelude.fromInteger)")
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    85
  (Scala "BigInt(_.toInt)"
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    86
    and "!((k: BigInt) => if (BigInt(0) <= k && k < BigInt(256)) k.charValue else error(\"character value out of range\"))")
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    87
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    88
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    89
code_const "Orderings.less_eq \<Colon> char \<Rightarrow> char \<Rightarrow> bool"
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    90
  (SML "!((_ : char) <= _)")
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    91
  (OCaml "!((_ : char) <= _)")
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    92
  (Haskell infix 4 "<=")
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    93
  (Scala infixl 4 "<=")
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    94
  (Eval infixl 6 "<=")
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    95
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    96
code_const "Orderings.less \<Colon> char \<Rightarrow> char \<Rightarrow> bool"
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    97
  (SML "!((_ : char) < _)")
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    98
  (OCaml "!((_ : char) < _)")
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
    99
  (Haskell infix 4 "<")
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
   100
  (Scala infixl 4 "<")
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
   101
  (Eval infixl 6 "<")
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
   102
24999
haftmann
parents:
diff changeset
   103
end
51160
599ff65b85e2 systematic conversions between nat and nibble/char;
haftmann
parents: 48431
diff changeset
   104