src/HOL/Library/Code_Char.thy
author haftmann
Tue Oct 27 15:32:20 2009 +0100 (2009-10-27)
changeset 33234 a5eba0447559
parent 32657 5f13912245ff
child 37222 4d984bc33c66
permissions -rw-r--r--
added implode and explode
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@32657
     8
imports List Code_Evaluation Main
haftmann@24999
     9
begin
haftmann@24999
    10
haftmann@24999
    11
code_type char
haftmann@24999
    12
  (SML "char")
haftmann@24999
    13
  (OCaml "char")
haftmann@24999
    14
  (Haskell "Char")
haftmann@24999
    15
haftmann@24999
    16
setup {*
haftmann@31053
    17
  fold String_Code.add_literal_char ["SML", "OCaml", "Haskell"] 
haftmann@31053
    18
  #> String_Code.add_literal_list_string "Haskell"
haftmann@24999
    19
*}
haftmann@24999
    20
haftmann@24999
    21
code_instance char :: eq
haftmann@24999
    22
  (Haskell -)
haftmann@24999
    23
haftmann@24999
    24
code_reserved SML
haftmann@24999
    25
  char
haftmann@24999
    26
haftmann@24999
    27
code_reserved OCaml
haftmann@24999
    28
  char
haftmann@24999
    29
haftmann@28346
    30
code_const "eq_class.eq \<Colon> char \<Rightarrow> char \<Rightarrow> bool"
haftmann@24999
    31
  (SML "!((_ : char) = _)")
haftmann@24999
    32
  (OCaml "!((_ : char) = _)")
haftmann@24999
    33
  (Haskell infixl 4 "==")
haftmann@24999
    34
haftmann@32657
    35
code_const "Code_Evaluation.term_of \<Colon> char \<Rightarrow> term"
haftmann@31046
    36
  (Eval "HOLogic.mk'_char/ (IntInf.fromInt/ (Char.ord/ _))")
haftmann@28228
    37
haftmann@33234
    38
haftmann@33234
    39
definition implode :: "string \<Rightarrow> String.literal" where
haftmann@33234
    40
  "implode = STR"
haftmann@33234
    41
haftmann@33234
    42
primrec explode :: "String.literal \<Rightarrow> string" where
haftmann@33234
    43
  "explode (STR s) = s"
haftmann@33234
    44
haftmann@33234
    45
lemma [code]:
haftmann@33234
    46
  "literal_case f s = f (explode s)"
haftmann@33234
    47
  "literal_rec f s = f (explode s)"
haftmann@33234
    48
  by (cases s, simp)+
haftmann@33234
    49
haftmann@33234
    50
code_reserved SML String
haftmann@33234
    51
haftmann@33234
    52
code_const implode
haftmann@33234
    53
  (SML "String.implode")
haftmann@33234
    54
  (OCaml "failwith/ \"implode\"")
haftmann@33234
    55
  (Haskell "_")
haftmann@33234
    56
haftmann@33234
    57
code_const explode
haftmann@33234
    58
  (SML "String.explode")
haftmann@33234
    59
  (OCaml "failwith/ \"explode\"")
haftmann@33234
    60
  (Haskell "_")
haftmann@33234
    61
haftmann@24999
    62
end