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