diff --git a/collects/mzlib/foreign.ss b/collects/mzlib/foreign.ss
index e27c328..5420645 100644
--- a/collects/mzlib/foreign.ss
+++ b/collects/mzlib/foreign.ss
@@ -1217,8 +1217,9 @@
          [TYPE?                (id name"?")]
          [make-TYPE            (id "make-"name)]
          [list->TYPE           (id "list->"name)]
+         [list*->TYPE          (id "list*->"name)]
          [TYPE->list           (id name"->list")]
-         [TYPE->C              (id name"->C")]
+         [TYPE->list*          (id name"->list*")]
          [TYPE-tag             (id name"-tag")]
          [(stype ...)          (ids (lambda (s) `(,name"-",s"-type")))]
          [(TYPE-SLOT ...)      (ids (lambda (s) `(,name"-",s)))]
@@ -1226,13 +1227,16 @@
          [(offset ...) (generate-temporaries
                                (ids (lambda (s) `(,s"-offset"))))])
       #'(define-values (_TYPE _TYPE-pointer TYPE? TYPE-tag make-TYPE
-                        list->TYPE TYPE->list TYPE-SLOT ... set-TYPE-SLOT! ...)
+                        list->TYPE list*->TYPE TYPE->list TYPE->list*
+                        TYPE-SLOT ... set-TYPE-SLOT! ...)
           (let*-values ([(stype ...)  (values slot-type ...)]
                         [(types)      (list stype ...)]
                         [(offsets)    (compute-offsets types)]
                         [(offset ...) (apply values offsets)])
-            (define-values (super-pointer super-tags super-types super-offsets)
-              (cstruct-info first-type (lambda () (values #f '() #f #f))))
+            (define-values (super-pointer super-tags super-types super-offsets
+                            super->list* list*->super)
+              (cstruct-info first-type
+                            (lambda () (values #f '() #f #f #f #f))))
             (define-cpointer-type _TYPE super-pointer)
             (define _TYPE* (_cpointer TYPE-tag (make-cstruct-type types)))
             (define all-tags (cons TYPE-tag super-tags))
@@ -1253,16 +1257,16 @@
             (define make-TYPE
               (if (and has-super? super-types super-offsets)
                 ;; init using all slots
-                (lambda values
-                  (if (= (length values) (length all-types))
+                (lambda vals
+                  (if (= (length vals) (length all-types))
                     (let ([block (malloc _TYPE*)])
                       (set-cpointer-tag! block all-tags)
                       (for-each (lambda (type ofs value)
                                   (ptr-set! block type 'abs ofs value))
-                                all-types all-offsets values)
+                                all-types all-offsets vals)
                       block)
                     (error '_TYPE "expecting ~s values, got ~s: ~e"
-                           (length all-types) (length values) values)))
+                           (length all-types) (length vals) vals)))
                 ;; normal initializer
                 (lambda (slot ...)
                   (let ([block (malloc _TYPE*)])
@@ -1270,19 +1274,44 @@
                     (ptr-set! block stype 'abs offset slot)
                     ...
                     block))))
-            (define (list->TYPE l) (apply make-TYPE l))
+            (define (list->TYPE vals) (apply make-TYPE vals))
+            (define (list*->TYPE vals)
+              (cond
+               [(TYPE? vals) vals]
+               [(= (length vals) (length all-types))
+                (let ([block (malloc _TYPE*)])
+                  (set-cpointer-tag! block all-tags)
+                  (for-each
+                   (lambda (type ofs value)
+                     (let-values ([(ptr tags types offsets T->list* list*->T)
+                                   (cstruct-info
+                                    type
+                                    (lambda () (values #f '() #f #f #f #f)))])
+                       (ptr-set! block type 'abs ofs
+                                 (if list*->T (list*->T value) value))))
+                   all-types all-offsets vals)
+                  block)]
+                [else (error '_TYPE "expecting ~s values, got ~s: ~e"
+                             (length all-types) (length vals) vals)]))
             (define (TYPE->list x)
               (unless (TYPE? x) (raise-type-error 'TYPE-list struct-string x))
-              (let loop ([x x] [types all-types] [offsets all-offsets])
-                (map (lambda (typ ofs)
-                       (let-values ([(v) (ptr-ref x typ 'abs ofs)]
-                                    [(ptr tags types offsets)
-                                     (cstruct-info
-                                      typ (lambda () (values #f '() #f #f)))])
-                         (if (and types offsets) (loop v types offsets) v)))
-                     types offsets)))
-            (cstruct-info _TYPE* 'set! _TYPE all-tags all-types all-offsets)
-            (values _TYPE* _TYPE TYPE? TYPE-tag make-TYPE list->TYPE TYPE->list
+              (map (lambda (type ofs) (ptr-ref x type 'abs ofs))
+                   all-types all-offsets))
+            (define (TYPE->list* x)
+              (unless (TYPE? x) (raise-type-error 'TYPE-list struct-string x))
+              (map (lambda (type ofs)
+                     (let-values ([(v) (ptr-ref x type 'abs ofs)]
+                                  [(ptr tags types offsets T->list* list*->T)
+                                   (cstruct-info
+                                    type
+                                    (lambda () (values #f '() #f #f #f #f)))])
+                       (if T->list* (T->list* v) v)))
+                   all-types all-offsets))
+            (cstruct-info
+             _TYPE* 'set!
+             _TYPE all-tags all-types all-offsets TYPE->list* list*->TYPE)
+            (values _TYPE* _TYPE TYPE? TYPE-tag make-TYPE
+                    list->TYPE list*->TYPE TYPE->list TYPE->list*
                     TYPE-SLOT ... set-TYPE-SLOT! ...)))))
   (define (identifiers? stx)
     (andmap identifier? (syntax->list stx)))