infix for literal prefab structs, quasiquote unquoting in value positions of hash-table literals, and related changes (v4.1.4.3)

svn: r13504

collects/drscheme/private/debug.ss

@@ -224,7 +224,9 @@ profile todo:
                                      orig-exp
                                      (namespace-syntax-introduce
                                       (datum->syntax #f orig-exp)))])
+                   (printf "> ~s\n" (syntax->datum exp))
                    (let ([top-e (expand-syntax-to-top-form exp)]) 
+                     (printf "~s\n" (syntax->datum top-e))
                      (syntax-case top-e (begin) 
                        [(begin expr ...)
                         ;; Found a `begin', so expand/eval each contained 

collects/scheme/private/qq-and-or.ss

@@ -328,7 +328,35 @@
                                                     (list (quote-syntax quote)
                                                           (prefab-struct-key (syntax-e x)))
                                                     l2))))
-                                      x))))))))
+                                      ;; hash or hasheq
+                                      (if (if (syntax? x)
+                                              (hash? (syntax-e x))
+                                              #f)
+                                          (letrec-values
+                                              (((qq-hash-assocs)
+						(lambda (x level)
+						  (if (null? x)
+						      (quote-syntax ())
+						      (let-values
+						          (((pair) (car x)))
+							(apply-cons
+							 (list (quote-syntax list*)
+							       (list (quote-syntax quote)
+								     (datum->syntax here (car pair)))
+							       (qq (datum->syntax here (cdr pair)) level))
+							 (qq-hash-assocs (cdr x) level)))))))
+                                            (let-values (((l0) (hash-map (syntax-e x) cons)))
+                                              (let-values
+                                                  (((l) (qq-hash-assocs l0 level)))
+                                                (if (eq? l0 l)
+                                                    x
+                                                    (list (if (hash-eq? (syntax-e x))
+                                                              (quote-syntax make-immutable-hasheq)
+                                                              (if (hash-eqv? (syntax-e x))
+                                                                  (quote-syntax make-immutable-hasheqv)
+                                                                  (quote-syntax make-immutable-hash)))
+                                                          l)))))
+                                          x)))))))))
 	      (qq form 0))
 	    form)
 	   in-form)))))

collects/scribblings/reference/reader.scrbl

@@ -582,8 +582,9 @@ can be disabled through the @scheme[read-square-bracket-as-paren] and
 
 The elements of the structure are recursively read until a matching
 @litchar{)}, @litchar{]}, or @litchar["}"] is found, just as for lists
-(see @secref["parse-pair"]). A delimited @litchar{.} is not allowed
+(see @secref["parse-pair"]). A single delimited @litchar{.} is not
-among the elements.
+allowed among the elements, but two @litchar{.}s can be used as in a
+list for an infix conversion.
 
 The first element is used as the structure descriptor, and it must
 have the form (when quoted) of a possible argument to

collects/scribblings/reference/stx-ops.scrbl

@@ -98,6 +98,9 @@ leaving nested syntax structure (if any) in place.  The result of
 
        @item{an immutable box containing @tech{syntax object}s}
 
+       @item{an immutable @tech{hash table} containing @tech{syntax
+       object} values (but not necessarily @tech{syntax object} keys)}
+
        @item{an immutable @tech{prefab} structure containing @tech{syntax object}s}
 
        @item{some other kind of datum---usually a number, boolean, or string}
@@ -128,13 +131,13 @@ are flattened.}
 
 Returns a datum by stripping the lexical information, source-location
 information, properties, and certificates from @scheme[stx]. Inside of
-pairs, (immutable) vectors, (immutable) boxes, and immutable
+pairs, (immutable) vectors, (immutable) boxes, immutable @tech{hash
-@tech{prefab} structures, @tech{syntax object}s are recursively
+table} values (not keys), and immutable @tech{prefab} structures,
-stripped.
+@tech{syntax object}s are recursively stripped.
 
 The stripping operation does not mutate @scheme[stx]; it creates new
-pairs, vectors, boxes, and @tech{prefab} structures as needed to strip lexical and
+pairs, vectors, boxes, hash tables, and @tech{prefab} structures as
-source-location information recursively.}
+needed to strip lexical and source-location information recursively.}
 
 @defproc[(datum->syntax [ctxt (or/c syntax? #f)]
                         [v any/c]
@@ -154,23 +157,25 @@ source-location information recursively.}
           syntax?]{
 
 Converts the @tech{datum} @scheme[v] to a @tech{syntax object}. If
-@scheme[v] is a pair, vector, box, or immutable @tech{prefab}
+@scheme[v] is a pair, vector, box, immutable hash table, or immutable
-structure, then the contents are recursively converted; mutable
+@tech{prefab} structure, then the contents are recursively converted;
-vectors and boxes are essentially replaced by immutable vectors and
+mutable vectors and boxes are essentially replaced by immutable
-boxes. @tech{Syntax object}s already in @scheme[v] are preserved as-is
+vectors and boxes. @tech{Syntax object}s already in @scheme[v] are
-in the result. For any kind of value other than a pair, vector, box,
+preserved as-is in the result. For any kind of value other than a
-immutable @tech{prefab} structure, or @tech{syntax object}, conversion
+pair, vector, box, immutable @tech{hash table}, immutable
-means wrapping the value with lexical information, source-location
+@tech{prefab} structure, or @tech{syntax object}, conversion means
+wrapping the value with lexical information, source-location
 information, properties, and certificates.
 
 Converted objects in @scheme[v] are given the lexical context
 information of @scheme[ctxt] and the source-location information of
-@scheme[srcloc]. If @scheme[v] is not already a @tech{syntax object}, then
+@scheme[srcloc]. If @scheme[v] is not already a @tech{syntax object},
-the resulting immediate @tech{syntax object} is given the properties (see
+then the resulting immediate @tech{syntax object} is given the
-@secref["stxprops"]) of @scheme[prop] and the @tech{inactive
+properties (see @secref["stxprops"]) of @scheme[prop] and the
-certificates} (see @secref["stxcerts"]) of @scheme[cert]; if
+@tech{inactive certificates} (see @secref["stxcerts"]) of
-@scheme[v] is a pair, vector, box, or immutable @tech{prefab} structure, 
+@scheme[cert]; if @scheme[v] is a pair, vector, box, immutable
-recursively converted values are not given properties or certificates.
+@tech{hash table}, or immutable @tech{prefab} structure, recursively
+converted values are not given properties or certificates.
 
 Any of @scheme[ctxt], @scheme[srcloc], @scheme[prop], or @scheme[cert]
 can be @scheme[#f], in which case the resulting syntax has no lexical
@@ -194,9 +199,10 @@ numbers or both be @scheme[#f], otherwise the
 @exnraise[exn:fail:contract].
 
 Graph structure is not preserved by the conversion of @scheme[v] to a
-@tech{syntax object}. Instead, @scheme[v] is essentially unfolded into a
+@tech{syntax object}. Instead, @scheme[v] is essentially unfolded into
-tree. If @scheme[v] has a cycle through pairs, vectors, boxes, and immutable 
+a tree. If @scheme[v] has a cycle through pairs, vectors, boxes,
-@tech{prefab} structures, then the @exnraise[exn:fail:contract].}
+immutable @tech{hash tables}, and immutable @tech{prefab} structures,
+then the @exnraise[exn:fail:contract].}
 
 @defproc[(identifier? [v any/c]) boolean?]{
 

collects/scribblings/reference/syntax.scrbl

@@ -1874,10 +1874,14 @@ quoted vector, or as an element of a quoted @tech{prefab} structure;
 in the case of a pair, if the @scheme[cdr] of the relevant quoted pair
 is empty, then @scheme[_expr] need not produce a list, and its result
 is used directly in place of the quoted pair (in the same way that
-@scheme[append] accepts a non-list final argument). If
+@scheme[append] accepts a non-list final argument).  In a quoted
-@scheme[unquote] or @scheme[unquote-splicing] appears within
+@tech{hash table}, an @scheme[(unquote _expr)] or
-@scheme[quasiquote] in any other way than as @scheme[(unquote _expr)]
+@scheme[(unquote-splicing _expr)] expression escapes only in the
-or @scheme[(unquote-splicing _expr)], a syntax error is reported.
+second element of an entry pair (i.e., the value), while entry keys
+are always implicitly quoted. If @scheme[unquote] or
+@scheme[unquote-splicing] appears within @scheme[quasiquote] in any
+other way than as @scheme[(unquote _expr)] or
+@scheme[(unquote-splicing _expr)], a syntax error is reported.
 
 @mz-examples[
 (eval:alts (#,(scheme quasiquote) (0 1 2)) `(0 1 2))
@@ -1895,6 +1899,8 @@ form is typically abbreviated with @litchar{`}, @litchar{,}, or
 `(0 1 2)
 `(1 ,(+ 1 2) 4)
 `#s(stuff 1 ,(+ 1 2) 4)
+(eval:alts #,(schemefont (schemevalfont "`#hash((\"a\" . ") "," (scheme (+ 1 2)) (schemevalfont "))")) #hash(("a" . 3)))
+`#hash((,(+ 1 2) . "a"))
 `(1 ,@(list 1 2) 4)
 `#(1 ,@(list 1 2) 4)
 ]

collects/sirmail/readr.ss

@@ -2563,12 +2563,13 @@
 					      (send t change-style url-delta s e)))
 				    (when (eq? (system-type) 'macosx)
                                       (when fn
-                                        (let ([safer-fn (normalize-path (build-path (find-system-path 'desk-dir)
+                                        (let ([and-open
-                                                                                    (regexp-replace* #rx"[/\"|:<>\\]" fn "-")))])
+                                               (lambda (dir)
-                                          (let ([and-open
+                                                 (let ([safer-fn (normalize-path (build-path (find-system-path 'home-dir)
-                                                 (lambda (dir)
+                                                                                             dir
+                                                                                             (regexp-replace* #rx"[/\"|:<>\\]" fn "-")))])
                                                    (insert " " set-standard-style)
-                                                   (insert (format "[~a & open]" dir)
+                                                   (insert (format "[~~/~a & open]" dir)
                                                            (lambda (t s e)
                                                              (send t set-clickback s e
                                                                    (lambda (a b c)
@@ -2576,9 +2577,9 @@
                                                                      (parameterize ([current-input-port (open-input-string "")])
                                                                        (system* "/usr/bin/open" (path->string safer-fn))))
                                                                    #f #f)
-                                                             (send t change-style url-delta s e))))])
+                                                             (send t change-style url-delta s e)))))])
-                                            (and-open "~/Desktop")
+                                          (and-open "Desktop")
-                                            (and-open "~/Temp"))))))
+                                          (and-open "Temp")))))
                                   (insert "\n" set-standard-style)
 				  (lambda ()
 				    (unless content

collects/sirmail/spell.ss

@@ -132,7 +132,8 @@
 					  '("/sw/bin"
 					    "/usr/bin"
 					    "/bin"
-					    "/usr/local/bin")))
+					    "/usr/local/bin"
+					    "/opt/local/bin")))
 				 '("ispell" "aspell"))
 			  (find-executable-path (if (eq? (system-type) 'windows)
 						    "aspell.exe"

collects/tests/mzscheme/syntax.ss

@@ -651,6 +651,28 @@
 (test '(quasiquote (quasiquote (quasiquote (unquote (unquote (unquote x)))))) 'qq ````,,,x)
 (test '(quasiquote (quasiquote (quasiquote (unquote (unquote (unquote 5)))))) 'qq ````,,,,x)
 
+(test '#hash() 'qq `#hash())
+(test '#hash(("apple" . 1) ("banana" . 2) ("coconut" . 3))
+      'qq
+      `#hash(("apple" . 1) ("banana" . 2) ("coconut" . 3)))
+(test '#hash(("apple" . 1) ("banana" . 2) ("coconut" . 3))
+      'qq
+      `#hash(("apple" . ,1) ("banana" . ,(add1 1)) ("coconut" . ,(+ 1 2))))
+(test '#hash(("foo" . (1 2 3 4 5)))
+      'qq
+      `#hash(("foo" . (1 2 ,(+ 1 2) 4 5))))
+(test '#hash(("foo" . (1 2 3 4 5)))
+      'qq
+      `#hash(("foo" . (1 2 ,@(list 3 4 5)))))
+(test '#hash((,(read) . 1) (,(+ 1 2) . 3))
+      'qq
+      `#hash((,(read) . 1) (,(+ 1 2) . ,(+ 1 2))))
+(test '#hash((,(read) . 2))
+      'qq
+      `#hash((,(read) . 1) (,(read) . 2)))
+(syntax-test #'`#hash(("foo" . ,@(list 1 2 3 4 5))))
+(error-test #'(read (open-input-string "`#hash((foo ,@(list 1 2 3 4 5)))")) exn:fail:read?)
+
 (test '(quasiquote (unquote result)) 'qq `(quasiquote ,result))
 (test (list 'quasiquote car) 'qq `(,'quasiquote ,car))
 

doc/release-notes/mzscheme/HISTORY.txt

@@ -1,3 +1,8 @@
+Version 4.1.4.3
+Allow infix notation for prefab structure literals
+Change quasiquote so that unquote works in value positions of #hash
+Change read-syntax to represent #hash value forms as syntax
+
 Version 4.1.4.2
 Added bitwise-bit-field
 

src/mzscheme/src/read.c

@@ -145,6 +145,7 @@ static MZ_INLINE long SPAN(Scheme_Object *port, long pos) {
 #define mz_shape_vec 1
 #define mz_shape_hash_list 2
 #define mz_shape_hash_elem 3
+#define mz_shape_vec_plus_infix 4
 
 typedef struct Readtable {
   Scheme_Object so;
@@ -208,7 +209,7 @@ static Scheme_Object *read_vector(Scheme_Object *port, Scheme_Object *stxsrc,
 				  long reqLen, const mzchar *reqBuffer,
 				  Scheme_Hash_Table **ht,
 				  Scheme_Object *indentation,
-				  ReadParams *params);
+				  ReadParams *params, int allow_infix);
 static Scheme_Object *read_number(int init_ch,
 				  Scheme_Object *port, Scheme_Object *stxsrc,
 				  long line, long col, long pos,
@@ -1045,7 +1046,7 @@ read_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table *
 	  break;
 	case '(':
 	  if (!params->honu_mode) {
-	    return read_vector(port, stxsrc, line, col, pos, ch, ')', -1, NULL, ht, indentation, params);
+	    return read_vector(port, stxsrc, line, col, pos, ch, ')', -1, NULL, ht, indentation, params, 0);
 	  }
 	  break;
 	case '[':
@@ -1054,7 +1055,7 @@ read_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table *
 	      scheme_read_err(port, stxsrc, line, col, pos, 2, 0, indentation, "read: bad syntax `#['");
 	      return NULL;
 	    } else
-	      return read_vector(port, stxsrc, line, col, pos, ch, ']', -1, NULL, ht, indentation, params);
+	      return read_vector(port, stxsrc, line, col, pos, ch, ']', -1, NULL, ht, indentation, params, 0);
 	  }
 	  break;
 	case '{':
@@ -1063,7 +1064,7 @@ read_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table *
 	      scheme_read_err(port, stxsrc, line, col, pos, 2, 0, indentation, "read: bad syntax `#{'");
 	      return NULL;
 	    } else
-	      return read_vector(port, stxsrc, line, col, pos, ch, '}', -1, NULL, ht, indentation, params);
+	      return read_vector(port, stxsrc, line, col, pos, ch, '}', -1, NULL, ht, indentation, params, 0);
 	  }
 	  break;
 	case '\\':
@@ -1153,7 +1154,7 @@ read_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table *
               else if (effective_ch == '{')
                 ch = '}';
 
-              v = read_vector(port, stxsrc, line, col, pos, orig_ch, ch, -1, NULL, ht, indentation, params);
+              v = read_vector(port, stxsrc, line, col, pos, orig_ch, ch, -1, NULL, ht, indentation, params, 1);
               if (stxsrc)
                 v = SCHEME_STX_VAL(v);
 
@@ -1697,11 +1698,11 @@ read_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table *
             effective_ch = readtable_effective_char(table, ch);
 
 	    if (effective_ch == '(')
-	      return read_vector(port, stxsrc, line, col, pos, ch, ')', vector_length, vecbuf, ht, indentation, params);
+	      return read_vector(port, stxsrc, line, col, pos, ch, ')', vector_length, vecbuf, ht, indentation, params, 0);
 	    if (effective_ch == '[' && params->square_brackets_are_parens)
-	      return read_vector(port, stxsrc, line, col, pos, ch, ']', vector_length, vecbuf, ht, indentation, params);
+	      return read_vector(port, stxsrc, line, col, pos, ch, ']', vector_length, vecbuf, ht, indentation, params, 0);
 	    if (effective_ch == '{' && params->curly_braces_are_parens)
-	      return read_vector(port, stxsrc, line, col, pos, ch, '}', vector_length, vecbuf, ht, indentation, params);
+	      return read_vector(port, stxsrc, line, col, pos, ch, '}', vector_length, vecbuf, ht, indentation, params, 0);
 
 	    if (ch == '#' && (vector_length != -1)) {
 	      /* Not a vector after all: a graph reference */
@@ -2720,7 +2721,10 @@ read_list(Scheme_Object *port,
 
       track_indentation(indentation, dotline, dotcol);
 
-      if (((shape != mz_shape_cons) && (shape != mz_shape_hash_elem)) || infixed) {
+      if (((shape != mz_shape_cons) 
+           && (shape != mz_shape_hash_elem)
+           && (shape != mz_shape_vec_plus_infix))
+          || infixed) {
 	scheme_read_err(port, stxsrc, dotline, dotcol, dotpos, 1, 0, indentation,
 			"read: illegal use of `%c'",
                         dot_ch);
@@ -2730,7 +2734,7 @@ read_list(Scheme_Object *port,
       cdr = read_inner(port, stxsrc, ht, indentation, params, RETURN_HONU_ANGLE);
       ch = skip_whitespace_comments(port, stxsrc, ht, indentation, params);
       effective_ch = readtable_effective_char(params->table, ch);
-      if (effective_ch != closer) {
+      if ((effective_ch != closer) || (shape == mz_shape_vec_plus_infix)) {
 	if (params->can_read_infix_dot 
             && (effective_ch == '.') 
             && next_is_delim(port, params, brackets, braces)) {
@@ -3271,14 +3275,16 @@ read_vector (Scheme_Object *port,
 	     int opener, char closer,
 	     long requestLength, const mzchar *reqBuffer,
 	     Scheme_Hash_Table **ht,
-	     Scheme_Object *indentation, ReadParams *params)
+	     Scheme_Object *indentation, ReadParams *params, int allow_infix)
 /* requestLength == -1 => no request
    requestLength == -2 => overflow */
 {
   Scheme_Object *lresult, *obj, *vec, **els;
   int len, i;
 
-  lresult = read_list(port, stxsrc, line, col, pos, opener, closer, mz_shape_vec, 1, ht, indentation, params);
+  lresult = read_list(port, stxsrc, line, col, pos, opener, closer, 
+                      allow_infix ? mz_shape_vec_plus_infix : mz_shape_vec, 
+                      1, ht, indentation, params);
 
   if (requestLength == -2) {
     scheme_raise_out_of_memory("read", "making vector of size %5", reqBuffer);
@@ -3974,12 +3980,11 @@ static Scheme_Object *read_hash(Scheme_Object *port, Scheme_Object *stxsrc,
 
     t = scheme_make_hash_tree(kind);
 
-    l = scheme_syntax_to_datum(l, 0, NULL);
+    for (; SCHEME_STX_PAIRP(l); l = SCHEME_STX_CDR(l)) {
-
+      val = SCHEME_STX_CAR(l);
-    for (; SCHEME_PAIRP(l); l = SCHEME_CDR(l)) {
+      key = SCHEME_STX_CAR(val);
-      val = SCHEME_CAR(l);
+      key = scheme_syntax_to_datum(key, 0, NULL);
-      key = SCHEME_CAR(val);
+      val = SCHEME_STX_CDR(val);
-      val = SCHEME_CDR(val);
       
       t = scheme_hash_tree_set(t, key, val);
     }

src/mzscheme/src/schvers.h

@@ -13,12 +13,12 @@
    consistently.)
 */
 
-#define MZSCHEME_VERSION "4.1.4.2"
+#define MZSCHEME_VERSION "4.1.4.3"
 
 #define MZSCHEME_VERSION_X 4
 #define MZSCHEME_VERSION_Y 1
 #define MZSCHEME_VERSION_Z 4
-#define MZSCHEME_VERSION_W 2
+#define MZSCHEME_VERSION_W 3
 
 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
 #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

src/mzscheme/src/stxobj.c

@@ -111,7 +111,7 @@ static void preemptive_chunk(Scheme_Stx *stx);
 #define CONS scheme_make_pair
 #define ICONS scheme_make_pair
 
-#define HAS_SUBSTX(obj) (SCHEME_PAIRP(obj) || SCHEME_VECTORP(obj) || SCHEME_BOXP(obj) || prefab_p(obj))
+#define HAS_SUBSTX(obj) (SCHEME_PAIRP(obj) || SCHEME_VECTORP(obj) || SCHEME_BOXP(obj) || prefab_p(obj) || SCHEME_HASHTRP(obj))
 
 XFORM_NONGCING static int prefab_p(Scheme_Object *o)
 {
@@ -2702,6 +2702,22 @@ Scheme_Object *scheme_stx_content(Scheme_Object *o)
       }
       
       v = v2;
+    } else if (SCHEME_HASHTRP(v)) {
+      Scheme_Hash_Tree *ht = (Scheme_Hash_Tree *)v, *ht2;
+      Scheme_Object *key, *val;
+      int i;
+
+      ht2 = scheme_make_hash_tree(SCHEME_HASHTR_FLAGS(ht) & 0x3);
+
+      i = scheme_hash_tree_next(ht, -1);
+      while (i != -1) {
+        scheme_hash_tree_index(ht, i, &key, &val);
+        val = propagate_wraps(val, wl_count, &ml, here_wraps);
+        ht2 = scheme_hash_tree_set(ht2, key, val);
+        i = scheme_hash_tree_next(ht, i);
+      }
+
+      v = (Scheme_Object *)ht2;
     } else if (prefab_p(v)) {
       Scheme_Structure *s = (Scheme_Structure *)v;
       Scheme_Object *r;
@@ -2893,6 +2909,42 @@ static Scheme_Object *stx_activate_certs(Scheme_Object *o, Scheme_Cert **cp)
 
     SCHEME_SET_IMMUTABLE(v2);
     return v2;
+  } else if (SCHEME_HASHTRP(o)) {
+    Scheme_Hash_Tree *ht = (Scheme_Hash_Tree *)o, *ht2;
+    Scheme_Object *key = NULL, *val, *e, *jkey;
+    int i, j;
+    
+    j = scheme_hash_tree_next(ht, -1);
+    while (j != -1) {
+      scheme_hash_tree_index(ht, j, &key, &val);
+      e = stx_activate_certs(val, cp);
+      if (!SAME_OBJ(e, val))
+        break;
+      j = scheme_hash_tree_next(ht, j);
+    }
+
+    if (j == -1)
+      return o;
+    jkey = key;
+
+    ht2 = scheme_make_hash_tree(SCHEME_HASHTR_FLAGS(ht) & 0x3);
+    
+    i = scheme_hash_tree_next(ht, -1);
+    while (i != j) {
+      scheme_hash_tree_index(ht, i, &key, &val);
+      ht2 = scheme_hash_tree_set(ht2, key, val);
+      i = scheme_hash_tree_next(ht, i);
+    }
+    ht2 = scheme_hash_tree_set(ht2, key, e);
+    i = scheme_hash_tree_next(ht, i);
+    while (i != -1) {
+      scheme_hash_tree_index(ht, i, &key, &val);
+      val = stx_activate_certs(val, cp);
+      ht2 = scheme_hash_tree_set(ht2, key, val);
+      i = scheme_hash_tree_next(ht, i);
+    }
+    
+    return (Scheme_Object *)ht2;
   } else if (prefab_p(o)) {
     Scheme_Object *e = NULL;
     Scheme_Structure *s = (Scheme_Structure *)o;
@@ -5831,6 +5883,22 @@ static Scheme_Object *syntax_to_datum_inner(Scheme_Object *o,
 
     result = r;
     SCHEME_SET_IMMUTABLE(result);
+  } else if (SCHEME_HASHTRP(v)) {
+    Scheme_Hash_Tree *ht = (Scheme_Hash_Tree *)v, *ht2;
+    Scheme_Object *key, *val;
+    int i;
+    
+    ht2 = scheme_make_hash_tree(SCHEME_HASHTR_FLAGS(ht) & 0x3);
+    
+    i = scheme_hash_tree_next(ht, -1);
+    while (i != -1) {
+      scheme_hash_tree_index(ht, i, &key, &val);
+      val = syntax_to_datum_inner(val, with_marks, mt);
+      ht2 = scheme_hash_tree_set(ht2, key, val);
+      i = scheme_hash_tree_next(ht, i);
+    }
+    
+    result = (Scheme_Object *)ht2;
   } else if (prefab_p(v)) {
     Scheme_Structure *s = (Scheme_Structure *)v;
     Scheme_Object *a;
@@ -6624,6 +6692,23 @@ static Scheme_Object *datum_to_syntax_inner(Scheme_Object *o,
     }
 
     SCHEME_SET_VECTOR_IMMUTABLE(result);
+  } else if (SCHEME_HASHTRP(o)) {
+    Scheme_Hash_Tree *ht1 = (Scheme_Hash_Tree *)o, *ht2;
+    Scheme_Object *key, *val;
+    int i;
+    
+    ht2 = scheme_make_hash_tree(SCHEME_HASHTR_FLAGS(ht1) & 0x3);
+    
+    i = scheme_hash_tree_next(ht1, -1);
+    while (i != -1) {
+      scheme_hash_tree_index(ht1, i, &key, &val);
+      val = datum_to_syntax_inner(val, ut, stx_src, stx_wraps, ht);
+      if (!val) return NULL;
+      ht2 = scheme_hash_tree_set(ht2, key, val);
+      i = scheme_hash_tree_next(ht1, i);
+    }
+    
+    result = (Scheme_Object *)ht2;
   } else if (prefab_p(o)) {
     Scheme_Structure *s = (Scheme_Structure *)o;
     Scheme_Object *a;
@@ -6632,6 +6717,7 @@ static Scheme_Object *datum_to_syntax_inner(Scheme_Object *o,
     s = (Scheme_Structure *)scheme_clone_prefab_struct_instance(s);
     for (i = 0; i < size; i++) {
       a = datum_to_syntax_inner(s->slots[i], ut, stx_src, stx_wraps, ht);
+      if (!a) return NULL;
       s->slots[i] = a;
     }
 
@@ -6854,6 +6940,17 @@ static void simplify_syntax_inner(Scheme_Object *o,
     for (i = 0; i < size; i++) {
       simplify_syntax_inner(SCHEME_VEC_ELS(v)[i], rns, marks);
     }
+  } else if (SCHEME_HASHTRP(v)) {
+    Scheme_Hash_Tree *ht = (Scheme_Hash_Tree *)v;
+    Scheme_Object *key, *val;
+    int i;
+    
+    i = scheme_hash_tree_next(ht, -1);
+    while (i != -1) {
+      scheme_hash_tree_index(ht, i, &key, &val);
+      simplify_syntax_inner(val, rns, marks);
+      i = scheme_hash_tree_next(ht, i);
+    }
   } else if (prefab_p(v)) {
     Scheme_Structure *s = (Scheme_Structure *)v;
     int size = s->stype->num_slots, i;