src/HOL/Library/Code_Char.thy
author wenzelm
Wed Jun 17 11:03:05 2015 +0200 (2015-06-17)
changeset 60500 903bb1495239
parent 58881 b9556a055632
child 61076 bdc1e2f0a86a
permissions -rw-r--r--
isabelle update_cartouches;
     1 (*  Title:      HOL/Library/Code_Char.thy
     2     Author:     Florian Haftmann
     3 *)
     4 
     5 section \<open>Code generation of pretty characters (and strings)\<close>
     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 \<open>
    19   fold String_Code.add_literal_char ["SML", "OCaml", "Haskell", "Scala"] 
    20   #> String_Code.add_literal_list_string "Haskell"
    21 \<close>
    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 code_reserved SML String
    44 
    45 code_printing
    46   constant String.implode \<rightharpoonup>
    47     (SML) "String.implode"
    48     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)"
    49     and (Haskell) "_"
    50     and (Scala) "!(\"\" ++/ _)"
    51 | constant String.explode \<rightharpoonup>
    52     (SML) "String.explode"
    53     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) [])"
    54     and (Haskell) "_"
    55     and (Scala) "!(_.toList)"
    56 
    57 
    58 definition integer_of_char :: "char \<Rightarrow> integer"
    59 where
    60   "integer_of_char = integer_of_nat o nat_of_char"
    61 
    62 definition char_of_integer :: "integer \<Rightarrow> char"
    63 where
    64   "char_of_integer = char_of_nat \<circ> nat_of_integer"
    65 
    66 lemma [code]:
    67   "nat_of_char = nat_of_integer o integer_of_char"
    68   by (simp add: integer_of_char_def fun_eq_iff)
    69 
    70 lemma [code]:
    71   "char_of_nat = char_of_integer o integer_of_nat"
    72   by (simp add: char_of_integer_def fun_eq_iff)
    73 
    74 lemmas integer_of_char_code [code] =
    75   nat_of_char_simps[
    76     THEN arg_cong[where f="integer_of_nat"],
    77     unfolded integer_of_nat_numeral integer_of_nat_1 integer_of_nat_0,
    78     folded fun_cong[OF integer_of_char_def, unfolded o_apply]]
    79 
    80 lemma char_of_integer_code [code]:
    81   "char_of_integer n = enum_class.enum ! (nat_of_integer n mod 256)"
    82 by(simp add: char_of_integer_def char_of_nat_def)
    83 
    84 code_printing
    85   constant integer_of_char \<rightharpoonup>
    86     (SML) "!(IntInf.fromInt o Char.ord)"
    87     and (OCaml) "Big'_int.big'_int'_of'_int (Char.code _)"
    88     and (Haskell) "Prelude.toInteger (Prelude.fromEnum (_ :: Prelude.Char))"
    89     and (Scala) "BigInt(_.toInt)"
    90 | constant char_of_integer \<rightharpoonup>
    91     (SML) "!(Char.chr o IntInf.toInt)"
    92     and (OCaml) "Char.chr (Big'_int.int'_of'_big'_int _)"
    93     and (Haskell) "!(let chr k | (0 <= k && k < 256) = Prelude.toEnum k :: Prelude.Char in chr . Prelude.fromInteger)"
    94     and (Scala) "!((k: BigInt) => if (BigInt(0) <= k && k < BigInt(256)) k.charValue else error(\"character value out of range\"))"
    95 | constant "Orderings.less_eq :: char \<Rightarrow> char \<Rightarrow> bool" \<rightharpoonup>
    96     (SML) "!((_ : char) <= _)"
    97     and (OCaml) "!((_ : char) <= _)"
    98     and (Haskell) infix 4 "<="
    99     and (Scala) infixl 4 "<="
   100     and (Eval) infixl 6 "<="
   101 | constant "Orderings.less :: char \<Rightarrow> char \<Rightarrow> bool" \<rightharpoonup>
   102     (SML) "!((_ : char) < _)"
   103     and (OCaml) "!((_ : char) < _)"
   104     and (Haskell) infix 4 "<"
   105     and (Scala) infixl 4 "<"
   106     and (Eval) infixl 6 "<"
   107 |  constant "Orderings.less_eq :: String.literal \<Rightarrow> String.literal \<Rightarrow> bool" \<rightharpoonup>
   108     (SML) "!((_ : string) <= _)"
   109     and (OCaml) "!((_ : string) <= _)"
   110     -- \<open>Order operations for @{typ String.literal} work in Haskell only 
   111           if no type class instance needs to be generated, because String = [Char] in Haskell
   112           and @{typ "char list"} need not have the same order as @{typ String.literal}.\<close>
   113     and (Haskell) infix 4 "<="
   114     and (Scala) infixl 4 "<="
   115     and (Eval) infixl 6 "<="
   116 | constant "Orderings.less :: String.literal \<Rightarrow> String.literal \<Rightarrow> bool" \<rightharpoonup>
   117     (SML) "!((_ : string) < _)"
   118     and (OCaml) "!((_ : string) < _)"
   119     and (Haskell) infix 4 "<"
   120     and (Scala) infixl 4 "<"
   121     and (Eval) infixl 6 "<"
   122 
   123 end
   124