# HG changeset patch
# User berghofe
# Date 1090253982 -7200
# Node ID 4f3102b501979a30bc4a8e3d855f0a4f3ed542aa
# Parent  a43d771c18acba40fcf00f7182963365b7a71e2d
- Moved code generator setup for lists from Main.thy to List.thy
- Code generator now represents char type as strings of length 1
  (easier to handle than encoding using nibbles)

diff -r a43d771c18ac -r 4f3102b50197 src/HOL/List.thy
--- a/src/HOL/List.thy	Mon Jul 19 18:15:46 2004 +0200
+++ b/src/HOL/List.thy	Mon Jul 19 18:19:42 2004 +0200
@@ -1608,14 +1608,21 @@
   in [("_Char", char_ast_tr), ("_String", string_ast_tr)] end;
 *}
 
+ML {*
+fun int_of_nibble h =
+  if "0" <= h andalso h <= "9" then ord h - ord "0"
+  else if "A" <= h andalso h <= "F" then ord h - ord "A" + 10
+  else raise Match;
+
+fun nibble_of_int i =
+  if i <= 9 then chr (ord "0" + i) else chr (ord "A" + i - 10);
+*}
+
 print_ast_translation {*
   let
     fun dest_nib (Syntax.Constant c) =
         (case explode c of
-          ["N", "i", "b", "b", "l", "e", h] =>
-            if "0" <= h andalso h <= "9" then ord h - ord "0"
-            else if "A" <= h andalso h <= "F" then ord h - ord "A" + 10
-            else raise Match
+          ["N", "i", "b", "b", "l", "e", h] => int_of_nibble h
         | _ => raise Match)
       | dest_nib _ = raise Match;
 
@@ -1637,4 +1644,56 @@
   in [("Char", char_ast_tr'), ("@list", list_ast_tr')] end;
 *}
 
+subsection {* Code generator setup *}
+
+ML {*
+local
+
+fun list_codegen thy gr dep b t =
+  let val (gr', ps) = foldl_map (Codegen.invoke_codegen thy dep false)
+    (gr, HOLogic.dest_list t)
+  in Some (gr', Pretty.list "[" "]" ps) end handle TERM _ => None;
+
+fun dest_nibble (Const (s, _)) = int_of_nibble (unprefix "List.nibble.Nibble" s)
+  | dest_nibble _ = raise Match;
+
+fun char_codegen thy gr dep b (Const ("List.char.Char", _) $ c1 $ c2) =
+    (let val c = chr (dest_nibble c1 * 16 + dest_nibble c2)
+     in if Symbol.is_printable c then Some (gr, Pretty.quote (Pretty.str c))
+       else None
+     end handle LIST _ => None | Match => None)
+  | char_codegen thy gr dep b _ = None;
+
+in
+
+val list_codegen_setup =
+  [Codegen.add_codegen "list_codegen" list_codegen,
+   Codegen.add_codegen "char_codegen" char_codegen];
+
+end;
+
+val term_of_list = HOLogic.mk_list;
+
+fun gen_list' aG i j = frequency
+  [(i, fn () => aG j :: gen_list' aG (i-1) j), (1, fn () => [])] ()
+and gen_list aG i = gen_list' aG i i;
+
+val nibbleT = Type ("List.nibble", []);
+
+fun term_of_char c =
+  Const ("List.char.Char", nibbleT --> nibbleT --> Type ("List.char", [])) $
+    Const ("List.nibble.Nibble" ^ nibble_of_int (ord c div 16), nibbleT) $
+    Const ("List.nibble.Nibble" ^ nibble_of_int (ord c mod 16), nibbleT);
+
+fun gen_char i = chr (random_range (ord "a") (Int.min (ord "a" + i, ord "z")));
+*}
+
+types_code
+  "list" ("_ list")
+  "char" ("string")
+
+consts_code "Cons" ("(_ ::/ _)")
+
+setup list_codegen_setup
+
 end