src/HOL/Library/Code_Char.thy
author Andreas Lochbihler
Wed Feb 27 10:33:30 2013 +0100 (2013-02-27)
changeset 51288 be7e9a675ec9
parent 51160 599ff65b85e2
child 51542 738598beeb26
permissions -rw-r--r--
add wellorder instance for Numeral_Type (suggested by Jesus Aransay)
haftmann@24999
     1
(*  Title:      HOL/Library/Code_Char.thy
haftmann@24999
     2
    Author:     Florian Haftmann
haftmann@24999
     3
*)
haftmann@24999
     4
haftmann@24999
     5
header {* Code generation of pretty characters (and strings) *}
haftmann@24999
     6
haftmann@24999
     7
theory Code_Char
haftmann@51160
     8
imports Main "~~/src/HOL/Library/Char_ord"
haftmann@24999
     9
begin
haftmann@24999
    10
haftmann@24999
    11
code_type char
haftmann@24999
    12
  (SML "char")
haftmann@24999
    13
  (OCaml "char")
haftmann@48431
    14
  (Haskell "Prelude.Char")
haftmann@37222
    15
  (Scala "Char")
haftmann@24999
    16
haftmann@24999
    17
setup {*
haftmann@37222
    18
  fold String_Code.add_literal_char ["SML", "OCaml", "Haskell", "Scala"] 
haftmann@31053
    19
  #> String_Code.add_literal_list_string "Haskell"
haftmann@24999
    20
*}
haftmann@24999
    21
haftmann@38857
    22
code_instance char :: equal
haftmann@24999
    23
  (Haskell -)
haftmann@24999
    24
haftmann@24999
    25
code_reserved SML
haftmann@24999
    26
  char
haftmann@24999
    27
haftmann@24999
    28
code_reserved OCaml
haftmann@24999
    29
  char
haftmann@24999
    30
haftmann@37222
    31
code_reserved Scala
haftmann@37222
    32
  char
haftmann@37222
    33
haftmann@38857
    34
code_const "HOL.equal \<Colon> char \<Rightarrow> char \<Rightarrow> bool"
haftmann@24999
    35
  (SML "!((_ : char) = _)")
haftmann@24999
    36
  (OCaml "!((_ : char) = _)")
haftmann@39272
    37
  (Haskell infix 4 "==")
haftmann@37222
    38
  (Scala infixl 5 "==")
haftmann@24999
    39
haftmann@32657
    40
code_const "Code_Evaluation.term_of \<Colon> char \<Rightarrow> term"
haftmann@31046
    41
  (Eval "HOLogic.mk'_char/ (IntInf.fromInt/ (Char.ord/ _))")
haftmann@28228
    42
haftmann@33234
    43
haftmann@33234
    44
definition implode :: "string \<Rightarrow> String.literal" where
haftmann@33234
    45
  "implode = STR"
haftmann@33234
    46
haftmann@33234
    47
code_reserved SML String
haftmann@33234
    48
haftmann@33234
    49
code_const implode
haftmann@33234
    50
  (SML "String.implode")
bulwahn@42598
    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)")
haftmann@33234
    52
  (Haskell "_")
haftmann@37459
    53
  (Scala "!(\"\" ++/ _)")
haftmann@33234
    54
haftmann@33234
    55
code_const explode
haftmann@33234
    56
  (SML "String.explode")
bulwahn@42598
    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) [])")
haftmann@33234
    58
  (Haskell "_")
haftmann@37459
    59
  (Scala "!(_.toList)")
haftmann@33234
    60
haftmann@51160
    61
haftmann@51160
    62
definition integer_of_char :: "char \<Rightarrow> integer"
haftmann@51160
    63
where
haftmann@51160
    64
  "integer_of_char = integer_of_nat o nat_of_char"
haftmann@51160
    65
haftmann@51160
    66
definition char_of_integer :: "integer \<Rightarrow> char"
haftmann@51160
    67
where
haftmann@51160
    68
  "char_of_integer = char_of_nat \<circ> nat_of_integer"
haftmann@51160
    69
haftmann@51160
    70
lemma [code]:
haftmann@51160
    71
  "nat_of_char = nat_of_integer o integer_of_char"
haftmann@51160
    72
  by (simp add: integer_of_char_def fun_eq_iff)
haftmann@51160
    73
haftmann@51160
    74
lemma [code]:
haftmann@51160
    75
  "char_of_nat = char_of_integer o integer_of_nat"
haftmann@51160
    76
  by (simp add: char_of_integer_def fun_eq_iff)
haftmann@51160
    77
haftmann@51160
    78
code_const integer_of_char and char_of_integer
haftmann@51160
    79
  (SML "!(IntInf.fromInt o Char.ord)"
haftmann@51160
    80
    and "!(Char.chr o IntInf.toInt)")
haftmann@51160
    81
  (OCaml "Big'_int.big'_int'_of'_int (Char.code _)"
haftmann@51160
    82
    and "Char.chr (Big'_int.int'_of'_big'_int _)")
haftmann@51160
    83
  (Haskell "Prelude.toInteger (Prelude.fromEnum (_ :: Prelude.Char))"
haftmann@51160
    84
    and "!(let chr k | (0 <= k && k < 256) = Prelude.toEnum k :: Prelude.Char in chr . Prelude.fromInteger)")
haftmann@51160
    85
  (Scala "BigInt(_.toInt)"
haftmann@51160
    86
    and "!((k: BigInt) => if (BigInt(0) <= k && k < BigInt(256)) k.charValue else error(\"character value out of range\"))")
haftmann@51160
    87
haftmann@51160
    88
haftmann@51160
    89
code_const "Orderings.less_eq \<Colon> char \<Rightarrow> char \<Rightarrow> bool"
haftmann@51160
    90
  (SML "!((_ : char) <= _)")
haftmann@51160
    91
  (OCaml "!((_ : char) <= _)")
haftmann@51160
    92
  (Haskell infix 4 "<=")
haftmann@51160
    93
  (Scala infixl 4 "<=")
haftmann@51160
    94
  (Eval infixl 6 "<=")
haftmann@51160
    95
haftmann@51160
    96
code_const "Orderings.less \<Colon> char \<Rightarrow> char \<Rightarrow> bool"
haftmann@51160
    97
  (SML "!((_ : char) < _)")
haftmann@51160
    98
  (OCaml "!((_ : char) < _)")
haftmann@51160
    99
  (Haskell infix 4 "<")
haftmann@51160
   100
  (Scala infixl 4 "<")
haftmann@51160
   101
  (Eval infixl 6 "<")
haftmann@51160
   102
haftmann@24999
   103
end
haftmann@51160
   104