added type 'syntax';
authorwenzelm
Thu, 03 Feb 1994 13:59:38 +0100
changeset 259 9c648760dba3
parent 258 e540b7d4ecb1
child 260 967813b8a7bf
added type 'syntax'; added syntax_consts (_K, _explode, _implode, ...);
src/Pure/Syntax/sextension.ML
--- a/src/Pure/Syntax/sextension.ML	Thu Feb 03 13:59:00 1994 +0100
+++ b/src/Pure/Syntax/sextension.ML	Thu Feb 03 13:59:38 1994 +0100
@@ -55,6 +55,7 @@
   val constants: sext -> (string list * string) list
   val pure_sext: sext
   val syntax_types: string list
+  val syntax_consts: (string list * string) list
   val constrainAbsC: string
 end;
 
@@ -211,7 +212,7 @@
   | bigimpl_ast_tr (*"_bigimpl"*) asts = raise_ast "bigimpl_ast_tr" asts;
 
 
-(* explode atoms *)  (* FIXME check, leading 0s (?) *)
+(* explode atoms *)
 
 fun explode_tr (*"_explode"*) [consC, nilC, bit0, bit1, Free (str, _)] =
       let
@@ -222,7 +223,7 @@
           | encode_bit 1 = bit1
           | encode_bit _ = sys_error "encode_bit";
 
-        fun encode_char c =
+        fun encode_char c =   (* FIXME leading 0s (?) *)
           mk_list (map encode_bit (radixpand (2, (ord c))));
       in
         mk_list (map encode_char (explode str))
@@ -335,20 +336,22 @@
   | dependent_tr' _ _ = raise Match;
 
 
-(* implode atoms *)  (* FIXME check *)
+(* implode atoms *)
 
 fun implode_ast_tr' (*"_implode"*) (asts as [Constant cons_name, nilC,
     bit0, bit1, bitss]) =
       let
-        fun fail () = raise_ast "implode_ast_tr'" asts;
+        fun err () = raise_ast "implode_ast_tr'" asts;
 
         fun strip_list lst =
           let val (xs, y) = unfold_ast_p cons_name lst
-          in if y = nilC then xs else fail ()
+          in if y = nilC then xs else err ()
           end;
 
         fun decode_bit bit =
-          if bit = bit0 then "0" else if bit = bit1 then "1" else fail ();
+          if bit = bit0 then "0"
+          else if bit = bit1 then "1"
+          else err ();
 
         fun decode_char bits =
           chr (#1 (scan_radixint (2, map decode_bit (strip_list bits))));
@@ -512,8 +515,10 @@
     print_ast_translation = [("_abs", abs_ast_tr'), ("_idts", idts_ast_tr'),
       ("==>", impl_ast_tr'), ("_implode", implode_ast_tr')]};
 
-val syntax_types = terminals @ [logic, "type", "types", "sort", "classes",
-  args, "idt", "idts", "aprop", "asms"];
+val syntax_types = terminals @ ["syntax", logic, "type", "types", "sort",
+  "classes", args, "idt", "idts", "aprop", "asms"];
+
+val syntax_consts = [(["_K", "_explode", "_implode"], "syntax")];
 
 val constrainAbsC = "_constrainAbs";
 val apropC = "_aprop";