src/HOL/Library/Code_Char.thy
author Andreas Lochbihler
Fri Sep 20 10:09:16 2013 +0200 (2013-09-20)
changeset 53745 788730ab7da4
parent 52435 6646bb548c6b
child 54596 368c70ee1f46
permissions -rw-r--r--
prefer Code.abort over code_abort
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
wenzelm@51542
     8
imports Main Char_ord
haftmann@24999
     9
begin
haftmann@24999
    10
haftmann@52435
    11
code_printing
haftmann@52435
    12
  type_constructor char \<rightharpoonup>
haftmann@52435
    13
    (SML) "char"
haftmann@52435
    14
    and (OCaml) "char"
haftmann@52435
    15
    and (Haskell) "Prelude.Char"
haftmann@52435
    16
    and (Scala) "Char"
haftmann@24999
    17
haftmann@24999
    18
setup {*
haftmann@37222
    19
  fold String_Code.add_literal_char ["SML", "OCaml", "Haskell", "Scala"] 
haftmann@31053
    20
  #> String_Code.add_literal_list_string "Haskell"
haftmann@24999
    21
*}
haftmann@24999
    22
haftmann@52435
    23
code_printing
haftmann@52435
    24
  class_instance char :: equal \<rightharpoonup>
haftmann@52435
    25
    (Haskell) -
haftmann@52435
    26
| constant "HOL.equal :: char \<Rightarrow> char \<Rightarrow> bool" \<rightharpoonup>
haftmann@52435
    27
    (SML) "!((_ : char) = _)"
haftmann@52435
    28
    and (OCaml) "!((_ : char) = _)"
haftmann@52435
    29
    and (Haskell) infix 4 "=="
haftmann@52435
    30
    and (Scala) infixl 5 "=="
haftmann@52435
    31
| constant "Code_Evaluation.term_of \<Colon> char \<Rightarrow> term" \<rightharpoonup>
haftmann@52435
    32
    (Eval) "HOLogic.mk'_char/ (IntInf.fromInt/ (Char.ord/ _))"
haftmann@24999
    33
haftmann@24999
    34
code_reserved SML
haftmann@24999
    35
  char
haftmann@24999
    36
haftmann@24999
    37
code_reserved OCaml
haftmann@24999
    38
  char
haftmann@24999
    39
haftmann@37222
    40
code_reserved Scala
haftmann@37222
    41
  char
haftmann@37222
    42
haftmann@33234
    43
definition implode :: "string \<Rightarrow> String.literal" where
haftmann@33234
    44
  "implode = STR"
haftmann@33234
    45
haftmann@33234
    46
code_reserved SML String
haftmann@33234
    47
haftmann@52435
    48
code_printing
haftmann@52435
    49
  constant implode \<rightharpoonup>
haftmann@52435
    50
    (SML) "String.implode"
haftmann@52435
    51
    and (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@52435
    52
    and (Haskell) "_"
haftmann@52435
    53
    and (Scala) "!(\"\" ++/ _)"
haftmann@52435
    54
| constant explode \<rightharpoonup>
haftmann@52435
    55
    (SML) "String.explode"
haftmann@52435
    56
    and (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@52435
    57
    and (Haskell) "_"
haftmann@52435
    58
    and (Scala) "!(_.toList)"
haftmann@33234
    59
haftmann@51160
    60
haftmann@51160
    61
definition integer_of_char :: "char \<Rightarrow> integer"
haftmann@51160
    62
where
haftmann@51160
    63
  "integer_of_char = integer_of_nat o nat_of_char"
haftmann@51160
    64
haftmann@51160
    65
definition char_of_integer :: "integer \<Rightarrow> char"
haftmann@51160
    66
where
haftmann@51160
    67
  "char_of_integer = char_of_nat \<circ> nat_of_integer"
haftmann@51160
    68
haftmann@51160
    69
lemma [code]:
haftmann@51160
    70
  "nat_of_char = nat_of_integer o integer_of_char"
haftmann@51160
    71
  by (simp add: integer_of_char_def fun_eq_iff)
haftmann@51160
    72
haftmann@51160
    73
lemma [code]:
haftmann@51160
    74
  "char_of_nat = char_of_integer o integer_of_nat"
haftmann@51160
    75
  by (simp add: char_of_integer_def fun_eq_iff)
haftmann@51160
    76
haftmann@52435
    77
code_printing
haftmann@52435
    78
  constant integer_of_char \<rightharpoonup>
haftmann@52435
    79
    (SML) "!(IntInf.fromInt o Char.ord)"
haftmann@52435
    80
    and (OCaml) "Big'_int.big'_int'_of'_int (Char.code _)"
haftmann@52435
    81
    and (Haskell) "Prelude.toInteger (Prelude.fromEnum (_ :: Prelude.Char))"
haftmann@52435
    82
    and (Scala) "BigInt(_.toInt)"
haftmann@52435
    83
| constant char_of_integer \<rightharpoonup>
haftmann@52435
    84
    (SML) "!(Char.chr o IntInf.toInt)"
haftmann@52435
    85
    and (OCaml) "Char.chr (Big'_int.int'_of'_big'_int _)"
haftmann@52435
    86
    and (Haskell) "!(let chr k | (0 <= k && k < 256) = Prelude.toEnum k :: Prelude.Char in chr . Prelude.fromInteger)"
haftmann@52435
    87
    and (Scala) "!((k: BigInt) => if (BigInt(0) <= k && k < BigInt(256)) k.charValue else error(\"character value out of range\"))"
haftmann@52435
    88
| constant "Orderings.less_eq :: char \<Rightarrow> char \<Rightarrow> bool" \<rightharpoonup>
haftmann@52435
    89
    (SML) "!((_ : char) <= _)"
haftmann@52435
    90
    and (OCaml) "!((_ : char) <= _)"
haftmann@52435
    91
    and (Haskell) infix 4 "<="
haftmann@52435
    92
    and (Scala) infixl 4 "<="
haftmann@52435
    93
    and (Eval) infixl 6 "<="
haftmann@52435
    94
| constant "Orderings.less :: char \<Rightarrow> char \<Rightarrow> bool" \<rightharpoonup>
haftmann@52435
    95
    (SML) "!((_ : char) < _)"
haftmann@52435
    96
    and (OCaml) "!((_ : char) < _)"
haftmann@52435
    97
    and (Haskell) infix 4 "<"
haftmann@52435
    98
    and (Scala) infixl 4 "<"
haftmann@52435
    99
    and (Eval) infixl 6 "<"
haftmann@51160
   100
haftmann@24999
   101
end
haftmann@51160
   102