* removed all "record"-related procedures, replacing them by

equivalent "struct" procedures.

src/ikarus.chars.ss

@@ -1,15 +1,9 @@
 
 (library (ikarus chars)
-  (export char=? char<? char<=? char>? char>=? ;char-whitespace?
-          char->integer integer->char
-          ;char-alphabetic? 
-          char-downcase)
+  (export char=? char<? char<=? char>? char>=? char->integer integer->char)
   (import 
     (except (ikarus)
-      char=? char<? char<=? char>? char>=?
-      integer->char char->integer
-      ;char-whitespace? char-alphabetic?
-      char-downcase)
+      char=? char<? char<=? char>? char>=?  integer->char char->integer)
     (ikarus system $pairs)
     (ikarus system $chars)
     (ikarus system $fx))
@@ -219,37 +213,4 @@
              (err c1))])))
 
 
-  ;;; XXX (define char-whitespace?
-  ;;; XXX   (lambda (c)
-  ;;; XXX     (cond 
-  ;;; XXX       [(memq c '(#\space #\tab #\newline #\return)) #t]
-  ;;; XXX       [(char? c) #f]
-  ;;; XXX       [else
-  ;;; XXX        (error 'char-whitespace? "~s is not a character" c)])))
-  
-  ;;; XXX (define char-alphabetic?
-  ;;; XXX   (lambda (c)
-  ;;; XXX     (cond
-  ;;; XXX       [(char? c)
-  ;;; XXX        (cond
-  ;;; XXX          [($char<= #\a c) ($char<= c #\z)]
-  ;;; XXX          [($char<= #\A c) ($char<= c #\Z)]
-  ;;; XXX          [else #f])]
-  ;;; XXX       [else 
-  ;;; XXX        (error 'char-alphabetic?  "~s is not a character" c)])))
-  
-  (define char-downcase
-    (lambda (c)
-      (cond
-        [(char? c)
-         (cond
-           [(and ($char<= #\A c) ($char<= c #\Z))
-            ($fixnum->char 
-              ($fx+ ($char->fixnum c)
-                    ($fx- ($char->fixnum #\a)
-                          ($char->fixnum #\A))))]
-           [else c])]
-        [else 
-         (error 'char-downcase "~s is not a character" c)])))
-
 )

src/ikarus.compiler.altcogen.ss

@@ -32,18 +32,18 @@
       (error who "invalid gensym ~s" x)))
   ;;;
   (define (check-label x)
-    (record-case x
+    (struct-case x
       [(code-loc label)
        (check-gensym label)]
       [else (error who "invalid label ~s" x)]))
   ;;;
   (define (check-var x)
-    (record-case x 
+    (struct-case x 
       [(var) (void)]
       [else (error who "invalid var ~s" x)]))
   ;;;
   (define (check-closure x)
-    (record-case x
+    (struct-case x
       [(closure label free*)
        (check-label label)
        (for-each check-var free*)]
@@ -51,7 +51,7 @@
   ;;;
   (define (mkfuncall op arg*)
     (import primops)
-    (record-case op
+    (struct-case op
       [(primref name)
        (cond
          [(primop? name)
@@ -60,7 +60,7 @@
       [else (make-funcall op arg*)]))
   ;;;
   (define (Expr x)
-    (record-case x
+    (struct-case x
       [(constant) x]
       [(var)      x]
       [(primref)  x]
@@ -84,19 +84,19 @@
       [else (error who "invalid expr ~s" x)]))
   ;;;
   (define (ClambdaCase x)
-    (record-case x
+    (struct-case x
       [(clambda-case info body)
        (make-clambda-case info (Expr body))]
       [else (error who "invalid clambda-case ~s" x)]))
   ;;;
   (define (Clambda x)
-    (record-case x
+    (struct-case x
       [(clambda label case* free* name)
        (make-clambda label (map ClambdaCase case*) free* name)]
       [else (error who "invalid clambda ~s" x)]))
   ;;;
   (define (Program x)
-    (record-case x 
+    (struct-case x 
       [(codes code* body)
        (make-codes (map Clambda code*) (Expr body))]
       [else (error who "invalid program ~s" x)]))
@@ -120,12 +120,12 @@
           [else (f (cdr free*) (fxadd1 i))])))
     (define (do-fix lhs* rhs* body)
       (define (handle-closure x)
-        (record-case x
+        (struct-case x
           [(closure code free*) 
            (make-closure code (map Var free*))]))
       (make-fix lhs* (map handle-closure rhs*) body))
     (define (Expr x)
-      (record-case x
+      (struct-case x
         [(constant) x]
         [(var)      (Var x)]
         [(primref)  x]
@@ -155,9 +155,9 @@
   ;;;
   (define (ClambdaCase free*)
     (lambda (x)
-      (record-case x
+      (struct-case x
         [(clambda-case info body)
-         (record-case info
+         (struct-case info
            [(case-info label args proper)
             (let ([cp (unique-var 'cp)])
               (make-clambda-case 
@@ -166,14 +166,14 @@
         [else (error who "invalid clambda-case ~s" x)])))
   ;;;
   (define (Clambda x)
-    (record-case x
+    (struct-case x
       [(clambda label case* free* name)
        (make-clambda label (map (ClambdaCase free*) case*) 
                      free* name)]
       [else (error who "invalid clambda ~s" x)]))
   ;;;
   (define (Program x)
-    (record-case x 
+    (struct-case x 
       [(codes code* body)
        (make-codes (map Clambda code*) ((Expr #f '()) body))]
       [else (error who "invalid program ~s" x)]))
@@ -199,15 +199,15 @@
       (make-primcall '$do-event '())
       x))
   (define (CaseExpr x)
-    (record-case x 
+    (struct-case x 
       [(clambda-case info body)
        (make-clambda-case info (Tail body))]))
   (define (CodeExpr x)
-    (record-case x
+    (struct-case x
       [(clambda L cases free name)
        (make-clambda L (map CaseExpr cases) free name)]))
   (define (CodesExpr x)
-    (record-case x 
+    (struct-case x 
       [(codes list body)
        (make-codes (map CodeExpr list) (Tail body))]))
   (CodesExpr x))
@@ -229,12 +229,12 @@
       x))
 
   (define (ClambdaCase x) 
-    (record-case x
+    (struct-case x
       [(clambda-case info body)
        (make-clambda-case info (Main body))]))
   ;;;
   (define (Clambda x)
-    (record-case x
+    (struct-case x
       [(clambda label case* free* name)
        (make-clambda label (map ClambdaCase case*) free* name)]))
   ;;;
@@ -244,7 +244,7 @@
         x))
   ;;;
   (define (Program x)
-    (record-case x 
+    (struct-case x 
       [(codes code* body)
        (make-codes (map Clambda code*) (Main body))]))
   ;;;
@@ -288,7 +288,7 @@
                   (k (cons a d))))))]))
   ;;;
   (define (S x k)
-    (record-case x
+    (struct-case x
       [(bind lhs* rhs* body)
        (do-bind lhs* rhs* (S body k))]
       [(seq e0 e1)
@@ -380,7 +380,7 @@
            (list size)))))
   ;;; impose value
   (define (V d x)
-    (record-case x 
+    (struct-case x 
       [(constant) (make-set d x)]
       [(var)      
        (cond
@@ -486,7 +486,7 @@
            (make-primcall 'return (list return-value-register))))))
   ;;; impose effect
   (define (E x)
-    (record-case x
+    (struct-case x
       [(seq e0 e1) (make-seq (E e0) (E e1))]
       [(conditional e0 e1 e2)
        (make-conditional (P e0) (E e1) (E e2))]
@@ -520,7 +520,7 @@
       [else (error who "invalid effect ~s" x)]))
   ;;; impose pred
   (define (P x)
-    (record-case x
+    (struct-case x
       [(constant) x]
       [(seq e0 e1) (make-seq (E e0) (P e1))]
       [(conditional e0 e1 e2)
@@ -585,7 +585,7 @@
                 (f (cdr args) (cdr locs) 
                    (cons t targs) (cons (car locs) tlocs))))]))))
   (define (Tail x)
-    (record-case x 
+    (struct-case x 
       [(constant) (VT x)]
       [(var)      (VT x)]
       [(primcall op rands) 
@@ -661,9 +661,9 @@
                    fargs flocs))])))
   ;;;
   (define (ClambdaCase x) 
-    (record-case x
+    (struct-case x
       [(clambda-case info body)
-       (record-case info
+       (struct-case info
          [(case-info label args proper)
           (let-values ([(rargs rlocs fargs flocs)
                         (partition-formals args)])
@@ -681,7 +681,7 @@
                 (make-locals locals body))))])]))
   ;;;
   (define (Clambda x)
-    (record-case x
+    (struct-case x
       [(clambda label case* free* name)
        (make-clambda label (map ClambdaCase case*) free* name)]))
   ;;;
@@ -691,7 +691,7 @@
       (make-locals locals x)))
   ;;;
   (define (Program x)
-    (record-case x 
+    (struct-case x 
       [(codes code* body)
        (make-codes (map Clambda code*) (Main body))]))
   ;;;
@@ -703,7 +703,7 @@
    empty-set?
    set->list list->set)
 
-  (define-record set (v))
+  (define-struct set (v))
 
   (define (make-empty-set) (make-set '()))
   (define (set-member? x s) 
@@ -983,7 +983,7 @@
    delete-node!)
   (import ListySet)
   ;;;
-  (define-record graph (ls))
+  (define-struct graph (ls))
   ;;;
   (define (empty-graph) (make-graph '()))
   ;;;
@@ -1051,7 +1051,7 @@
    delete-node!)
   (import IntegerSet)
   ;;;
-  (define-record graph (ls))
+  (define-struct graph (ls))
   ;;;
   (define (empty-graph) (make-graph '()))
   ;;;
@@ -1262,7 +1262,7 @@
        (let-values ([(vs rs fs ns) (R (car ls) vs rs fs ns)])
           (R* (cdr ls) vs rs fs ns))]))
   (define (E x vs rs fs ns)
-    (record-case x
+    (struct-case x
       [(seq e0 e1) 
        (let-values ([(vs rs fs ns) (E e1 vs rs fs ns)])
          (E e0 vs rs fs ns))]
@@ -1488,7 +1488,7 @@
   (define (P x vst rst fst nst 
                vsf rsf fsf nsf
                vsu rsu fsu nsu)
-    (record-case x
+    (struct-case x
       [(seq e0 e1) 
        (let-values ([(vs rs fs ns) 
                      (P e1 vst rst fst nst 
@@ -1529,7 +1529,7 @@
                     vsu rsu fsu nsu)))]
       [else (error who "invalid pred ~s" (unparse x))]))
   (define (T x)
-    (record-case x
+    (struct-case x
       [(seq e0 e1) 
        (let-values ([(vs rs fs ns) (T e1)])
          (E e0 vs rs fs ns))]
@@ -1609,7 +1609,7 @@
         (or (assign-move x)
             (assign-any))))
     (define (NFE idx mask x)
-      (record-case x
+      (struct-case x
         [(seq e0 e1) 
          (let ([e0 (E e0)])
            (make-seq e0 (NFE idx mask e1)))]
@@ -1642,7 +1642,7 @@
          (make-disp (R (disp-s0 x)) (R (disp-s1 x)))]
         [else (error who "invalid R ~s" (unparse x))]))
     (define (E x)
-      (record-case x
+      (struct-case x
         [(seq e0 e1)
          (let ([e0 (E e0)])
            (make-seq e0 (E e1)))]
@@ -1767,7 +1767,7 @@
          (make-shortcut (E body) (E handler))]
         [else (error who "invalid effect ~s" (unparse x))]))
     (define (P x)
-      (record-case x
+      (struct-case x
         [(seq e0 e1)
          (let ([e0 (E e0)])
            (make-seq e0 (P e1)))]
@@ -1779,7 +1779,7 @@
          (make-shortcut (P body) (P handler))]
         [else (error who "invalid pred ~s" (unparse x))]))
     (define (T x)
-      (record-case x
+      (struct-case x
         [(seq e0 e1)
          (let ([e0 (E e0)])
            (make-seq e0 (T e1)))]
@@ -1792,7 +1792,7 @@
     (T x))
   ;;;
   (define (Main x)
-    (record-case x 
+    (struct-case x 
       [(locals vars body)
        (init-vars! vars)
        (let ([varvec (list->vector vars)])
@@ -1809,17 +1809,17 @@
       [else (error 'assign-frame-sizes "invalid main ~s" x)]))
   ;;;
   (define (ClambdaCase x) 
-    (record-case x
+    (struct-case x
       [(clambda-case info body)
        (make-clambda-case info (Main body))]))
   ;;;
   (define (Clambda x)
-    (record-case x
+    (struct-case x
       [(clambda label case* free* name)
        (make-clambda label (map ClambdaCase case*) free* name)]))
   ;;;
   (define (Program x)
-    (record-case x 
+    (struct-case x 
       [(codes code* body)
        (make-codes (map Clambda code*) (Main body))]))
   ;;;
@@ -1847,7 +1847,7 @@
         [(null? ls) (make-empty-set)]
         [else (set-union (R (car ls)) (R* (cdr ls)))]))
     (define (R x)
-      (record-case x
+      (struct-case x
         [(constant) (make-empty-set)]
         [(var) (list->set (list x))]
         [(disp s0 s1) (set-union (R s0) (R s1))]
@@ -1862,7 +1862,7 @@
            [else (error who "invalid R ~s" x)])]))
     ;;; build effect
     (define (E x s)
-      (record-case x
+      (struct-case x
         [(asm-instr op d v)
          (case op
            [(move)
@@ -1929,7 +1929,7 @@
              (E body s)))]
         [else (error who "invalid effect ~s" (unparse x))]))
     (define (P x st sf su)
-      (record-case x
+      (struct-case x
         [(constant c) (if c st sf)]
         [(seq e0 e1)
          (E e0 (P e1 st sf su))]
@@ -1944,7 +1944,7 @@
              (P body st sf su)))]
         [else (error who "invalid pred ~s" (unparse x))]))
     (define (T x)
-      (record-case x
+      (struct-case x
         [(conditional e0 e1 e2)
          (let ([s1 (T e1)] [s2 (T e2)])
            (P e0 s1 s2 (set-union s1 s2)))]
@@ -2028,30 +2028,30 @@
         [(assq x env) => cdr]
         [else x]))
     (define (Rhs x)
-      (record-case x
+      (struct-case x
         [(var) (Var x)]
         [(primcall op rand*)
          (make-primcall op (map Rand rand*))]
         [else x]))
     (define (Rand x) 
-      (record-case x
+      (struct-case x
         [(var) (Var x)]
         [else x]))
     (define (Lhs x)
-      (record-case x
+      (struct-case x
         [(var) (Var x)]
         [(nfv confs loc) 
          (or loc (error who "LHS not set ~s" x))]
         [else x]))
     (define (D x)
-      (record-case x
+      (struct-case x
         [(constant) x]
         [(var) (Var x)]
         [(fvar) x]
         [else
          (if (symbol? x) x (error who "invalid D ~s" x))]))
     (define (R x)
-      (record-case x
+      (struct-case x
         [(constant) x]
         [(var) (Var x)]
         [(fvar)     x]
@@ -2062,7 +2062,7 @@
          (if (symbol? x) x (error who "invalid R ~s" x))]))
     ;;; substitute effect
     (define (E x)
-      (record-case x
+      (struct-case x
         [(seq e0 e1) (make-seq (E e0) (E e1))]
         [(conditional e0 e1 e2) 
          (make-conditional (P e0) (E e1) (E e2))]
@@ -2075,7 +2075,7 @@
          (make-shortcut (E body) (E handler))]
         [else (error who "invalid effect ~s" (unparse x))]))
     (define (P x)
-      (record-case x
+      (struct-case x
         [(constant) x]
         [(asm-instr op x v)
          (make-asm-instr op (R x) (R v))]
@@ -2086,7 +2086,7 @@
          (make-shortcut (P body) (P handler))]
         [else (error who "invalid pred ~s" (unparse x))])) 
     (define (T x)
-      (record-case x
+      (struct-case x
         [(primcall op rands) x]
         [(conditional e0 e1 e2) 
          (make-conditional (P e0) (T e1) (T e2))]
@@ -2141,7 +2141,7 @@
       (or (disp? x) (fvar? x)))
     ;;; unspillable effect
     (define (E x)
-      (record-case x
+      (struct-case x
         [(seq e0 e1) (make-seq (E e0) (E e1))]
         [(conditional e0 e1 e2)
          (make-conditional (P e0) (E e1) (E e2))]
@@ -2252,7 +2252,7 @@
            (make-shortcut body (E handler)))]
         [else (error who "invalid effect ~s" (unparse x))]))
     (define (P x)
-      (record-case x
+      (struct-case x
         [(constant) x]
         [(primcall op rands)
          (let ([a0 (car rands)] [a1 (cadr rands)])
@@ -2286,7 +2286,7 @@
            (make-shortcut body (P handler)))]
         [else (error who "invalid pred ~s" (unparse x))]))
     (define (T x)
-      (record-case x
+      (struct-case x
         [(primcall op rands) x]
         [(conditional e0 e1 e2)
          (make-conditional (P e0) (T e1) (T e2))]
@@ -2299,7 +2299,7 @@
   ;;;
   (define (color-program x)
     (define who 'color-program)
-    (record-case x 
+    (struct-case x 
       [(locals vars body)
        (let ([varvec (car vars)] [sp* (cdr vars)])
          (let loop ([sp* (list->set sp*)] [un* (make-empty-set)] [body body])
@@ -2316,17 +2316,17 @@
   (define (color-by-chaitin x)
     ;;;
     (define (ClambdaCase x) 
-      (record-case x
+      (struct-case x
         [(clambda-case info body)
          (make-clambda-case info (color-program body))]))
     ;;;
     (define (Clambda x)
-      (record-case x
+      (struct-case x
         [(clambda label case* free* name)
          (make-clambda label (map ClambdaCase case*) free* name)]))
     ;;;
     (define (Program x)
-      (record-case x 
+      (struct-case x 
         [(codes code* body)
          (make-codes (map Clambda code*) (color-program body))]))
     ;;;
@@ -2344,7 +2344,7 @@
     `(disp ,(* i (- wordsize)) ,fpr))
   ;;;
   (define (C x)
-    (record-case x
+    (struct-case x
       [(code-loc label) (label-address label)]
       [(foreign-label L) `(foreign-label ,L)]
       [(closure label free*)
@@ -2357,19 +2357,19 @@
            x
            (error who "invalid constant C ~s" x))]))
   (define (BYTE x)
-    (record-case x
+    (struct-case x
       [(constant x)
        (unless (and (integer? x) (fx<= x 255) (fx<= -128 x))
          (error who "invalid byte ~s" x))
        x]
       [else (error who "invalid byte ~s" x)]))
   (define (D x)
-    (record-case x
+    (struct-case x
       [(constant c) (C c)]
       [else
        (if (symbol? x) x (error who "invalid D ~s" x))]))
   (define (R x)
-    (record-case x
+    (struct-case x
       [(constant c) (C c)]
       [(fvar i) (FVar i)]
       [(disp s0 s1) 
@@ -2378,7 +2378,7 @@
       [else
        (if (symbol? x) x (error who "invalid R ~s" x))]))
   (define (R/l x)
-    (record-case x
+    (struct-case x
       [(constant c) (C c)]
       [(fvar i) (FVar i)]
       [(disp s0 s1) 
@@ -2397,7 +2397,7 @@
        => cadr]
       [else (error who "invalid reg/l ~s" x)])) 
   (define (R/cl x)
-    (record-case x
+    (struct-case x
       [(constant i) 
        (unless (fixnum? i)
          (error who "invalid R/cl ~s" x))
@@ -2407,12 +2407,12 @@
            '%cl
            (error who "invalid R/cl ~s" x))]))
   (define (interrupt? x)
-    (record-case x
+    (struct-case x
       [(primcall op args) (eq? op 'interrupt)]
       [else #f]))
   ;;; flatten effect
   (define (E x ac)
-    (record-case x
+    (struct-case x
       [(seq e0 e1) (E e0 (E e1 ac))]
       [(conditional e0 e1 e2)
        (cond
@@ -2568,7 +2568,7 @@
     (label (gensym)))
   ;;;
   (define (P x lt lf ac)
-    (record-case x
+    (struct-case x
       [(constant c) 
        (if c
            (if lt (cons `(jmp ,lt) ac) ac)
@@ -2668,7 +2668,7 @@
       [else (error who "invalid pred ~s" x)]))
   ;;;
   (define (T x ac)
-    (record-case x
+    (struct-case x
       [(seq e0 e1) (E e0 (T e1 ac))]
       [(conditional e0 e1 e2)
        (let ([L (unique-label)])
@@ -2756,9 +2756,9 @@
        (handle-vararg (length (cdr args)) ac)]))
   ;;;
   (define (ClambdaCase x ac) 
-    (record-case x
+    (struct-case x
       [(clambda-case info body)
-       (record-case info
+       (struct-case info
          [(case-info L args proper)
           (let ([lothers (unique-label)])
             (cons* `(cmpl ,(argc-convention 
@@ -2777,7 +2777,7 @@
                         (T body (cons lothers ac))))))])]))
   ;;;
   (define (Clambda x)
-    (record-case x
+    (struct-case x
       [(clambda L case* free* name)
        (cons* (length free*) 
               `(name ,name)
@@ -2794,7 +2794,7 @@
   (define exceptions-conc (make-parameter #f))
   ;;;
   (define (Program x)
-    (record-case x 
+    (struct-case x 
       [(codes code* body)
        (cons (cons* 0 
                     (label (gensym))

src/ikarus.compiler.ss

@@ -8,7 +8,7 @@
     (ikarus system $fx)
     (ikarus system $pairs)
     (only (ikarus system $codes) $code->closure)
-    (only (ikarus system $records) $record-ref $record/rtd?)
+    (only (ikarus system $structs) $struct-ref $struct/rtd?)
     (except (ikarus)
         compile-core-expr-to-port assembler-output
         current-primitive-locations eval-core)
@@ -17,7 +17,7 @@
     )
 
 
-(define-syntax record-case
+(define-syntax struct-case
   (lambda (x)
     (define (enumerate fld* i)
       (syntax-case fld* ()
@@ -33,8 +33,8 @@
          (with-syntax ([altern (generate-body ctxt #'rest)]
                        [(id* ...) (enumerate #'(rec-field* ...) 0)]
                        [rtd #'(type-descriptor rec-name)])
-          #'(if ($record/rtd? v rtd)
-                (let ([rec-field* ($record-ref v id*)] ...)
+          #'(if ($struct/rtd? v rtd)
+                (let ([rec-field* ($struct-ref v id*)] ...)
                   b b* ...)
                 altern))]))
     (syntax-case x ()
@@ -45,55 +45,55 @@
 (include "set-operations.ss")
 
   
-(define-record constant (value))
-(define-record code-loc (label))
-(define-record foreign-label (label))
-(define-record var 
+(define-struct constant (value))
+(define-struct code-loc (label))
+(define-struct foreign-label (label))
+(define-struct var 
    (name assigned referenced 
          reg-conf frm-conf var-conf reg-move frm-move var-move
          loc index))
-(define-record cp-var (idx))
-(define-record frame-var (idx))
-(define-record new-frame (base-idx size body))
-(define-record save-cp (loc))
-(define-record eval-cp (check body))
-(define-record return (value))
-(define-record call-cp
+(define-struct cp-var (idx))
+(define-struct frame-var (idx))
+(define-struct new-frame (base-idx size body))
+(define-struct save-cp (loc))
+(define-struct eval-cp (check body))
+(define-struct return (value))
+(define-struct call-cp
   (call-convention label save-cp? rp-convention base-idx arg-count live-mask))
-(define-record tailcall-cp (convention label arg-count))
-(define-record primcall (op arg*))
-(define-record primref (name))
-(define-record conditional (test conseq altern))
-(define-record interrupt-call (test handler))
-(define-record bind (lhs* rhs* body))
-(define-record recbind (lhs* rhs* body))
-(define-record rec*bind (lhs* rhs* body))
-(define-record fix (lhs* rhs* body))
+(define-struct tailcall-cp (convention label arg-count))
+(define-struct primcall (op arg*))
+(define-struct primref (name))
+(define-struct conditional (test conseq altern))
+(define-struct interrupt-call (test handler))
+(define-struct bind (lhs* rhs* body))
+(define-struct recbind (lhs* rhs* body))
+(define-struct rec*bind (lhs* rhs* body))
+(define-struct fix (lhs* rhs* body))
 
-(define-record seq (e0 e1))
-(define-record case-info (label args proper))
-(define-record clambda-case (info body))
-(define-record clambda (label cases free name))
-(define-record closure (code free*))
-(define-record funcall (op rand*))
-(define-record jmpcall (label op rand*))
-(define-record forcall (op rand*))
-(define-record codes (list body))
-(define-record assign (lhs rhs))
-(define-record mvcall (producer consumer))
+(define-struct seq (e0 e1))
+(define-struct case-info (label args proper))
+(define-struct clambda-case (info body))
+(define-struct clambda (label cases free name))
+(define-struct closure (code free*))
+(define-struct funcall (op rand*))
+(define-struct jmpcall (label op rand*))
+(define-struct forcall (op rand*))
+(define-struct codes (list body))
+(define-struct assign (lhs rhs))
+(define-struct mvcall (producer consumer))
 
 
 
-(define-record shortcut (body handler))
+(define-struct shortcut (body handler))
 
-(define-record fvar (idx))
-(define-record object (val))
-(define-record locals (vars body))
-(define-record nframe (vars live body))
-(define-record nfv (conf loc var-conf frm-conf nfv-conf))
-(define-record ntcall (target value args mask size))
-(define-record asm-instr (op dst src))
-(define-record disp (s0 s1))
+(define-struct fvar (idx))
+(define-struct object (val))
+(define-struct locals (vars body))
+(define-struct nframe (vars live body))
+(define-struct nfv (conf loc var-conf frm-conf nfv-conf))
+(define-struct ntcall (target value args mask size))
+(define-struct asm-instr (op dst src))
+(define-struct disp (s0 s1))
 
 (define mkfvar
   (let ([cache '()])
@@ -266,7 +266,7 @@
             [(null? d) (E a)]
             [else (cons (E a) (f (car d) (cdr d)))]))))
   (define (E x)
-    (record-case x
+    (struct-case x
       [(constant c) `(quote ,c)]
       [(code-loc x) `(code-loc ,x)]
       [(var x) (string->symbol (format "v:~a" x))]
@@ -291,7 +291,7 @@
       [(seq e0 e1) 
        (let ()
          (define (f x ac)
-           (record-case x
+           (struct-case x
              [(seq e0 e1) (f e0 (f e1 ac))]
              [else (cons (E x) ac)]))
          (cons 'begin (f e0 (f e1 '()))))]
@@ -376,9 +376,9 @@
        (list (make-conses rhs*))]
       [else (cons (car rhs*) (properize (cdr lhs*) (cdr rhs*)))]))
   (define (inline-case cls rand*)
-    (record-case cls
+    (struct-case cls
       [(clambda-case info body)
-       (record-case info
+       (struct-case info
          [(case-info label fml* proper)
           (if proper
               (and (fx= (length fml*) (length rand*))
@@ -392,26 +392,26 @@
       [else (try-inline (cdr cls*) rand* default)]))
   (define (inline rator rand*)
     (define (valid-mv-consumer? x)
-      (record-case x
+      (struct-case x
         [(clambda L cases F)
          (and (fx= (length cases) 1)
-              (record-case (car cases)
+              (struct-case (car cases)
                 [(clambda-case info body)
-                 (record-case info
+                 (struct-case info
                    [(case-info L args proper) proper])]))]
         [else #f]))
     (define (single-value-consumer? x)
-      (record-case x
+      (struct-case x
         [(clambda L cases F)
          (and (fx= (length cases) 1)
-              (record-case (car cases)
+              (struct-case (car cases)
                 [(clambda-case info body)
-                 (record-case info
+                 (struct-case info
                    [(case-info L args proper)
                     (and proper (fx= (length args) 1))])]))]
         [else #f])) 
     (define (valid-mv-producer? x)
-      (record-case x
+      (struct-case x
         [(funcall) #t]
         [(conditional) #f]
         [(bind lhs* rhs* body) (valid-mv-producer? body)]
@@ -419,7 +419,7 @@
        ; [else (error 'valid-mv-producer? "unhandles ~s"
        ;              (unparse x))]
         ))
-    (record-case rator
+    (struct-case rator
       [(clambda g cls*)
        (try-inline cls* rand*
           (make-funcall rator rand*))]
@@ -445,7 +445,7 @@
           (make-funcall rator rand*)])]
       [else (make-funcall rator rand*)]))
   (define (Expr x)
-    (record-case x
+    (struct-case x
       [(constant) x]
       [(var) x]
       [(primref) x]
@@ -465,7 +465,7 @@
       [(clambda g cls* free name)
        (make-clambda g
          (map (lambda (x)
-                (record-case x
+                (struct-case x
                   [(clambda-case info body)
                    (make-clambda-case info (Expr body))]))
               cls*)
@@ -586,7 +586,7 @@
          (make-assign (car lhs*) (car rhs*))
          (build-assign* (cdr lhs*) (cdr rhs*) body))]))
   (define (E x ref comp)
-    (record-case x
+    (struct-case x
       [(constant) x]
       [(var) (ref x) x]
       [(assign lhs rhs)
@@ -613,7 +613,7 @@
       [(clambda g cls* free name)
        (make-clambda g
          (map (lambda (x)
-                (record-case x
+                (struct-case x
                   [(clambda-case info body)
                    (let ([h (make-eq-hashtable)])
                      (let ([body (E body (extend-hash (case-info-args info) h ref) void)])
@@ -622,7 +622,7 @@
          free name)]
       [(funcall rator rand*)
        (let ([rator (E rator ref comp)] [rand* (E* rand* ref comp)])
-         (record-case rator
+         (struct-case rator
            [(primref op)
             (unless (memq op simple-primitives)
               (comp))]
@@ -648,7 +648,7 @@
     (set-var-assigned! x #f)
     (set-var-referenced! x #f))
   (define (Expr x)
-    (record-case x
+    (struct-case x
       [(constant) (void)]
       [(var) (set-var-referenced! x #t)]
       [(primref) (void)]
@@ -667,7 +667,7 @@
       [(clambda g cls*)
        (for-each
          (lambda (cls)
-           (record-case cls
+           (struct-case cls
              [(clambda-case info body)
               (for-each init-var (case-info-args info))
               (Expr body)]))
@@ -727,7 +727,7 @@
       [else
        (make-funcall (make-primref op) rand*)]))
   (define (constant-value x k) 
-    (record-case x 
+    (struct-case x 
       [(constant t) (k t)] ; known
       [(bind lhs* rhs* body) (constant-value body k)]
       [(fix lhs* rhs* body) (constant-value body k)]
@@ -887,7 +887,7 @@
                   [(p) (mk-seq (mk-seq a0 a1) (make-constant #t))]
                   [else (giveup)])))
          (giveup))]
-    [($record-ref $record/rtd?)
+    [($record-ref $record/rtd? $struct-ref $struct/rtd?)
      (or (and (fx= (length rand*) 2)
               (let ([a0 (car rand*)] [a1 (cadr rand*)])
                 (case ctxt
@@ -1044,7 +1044,7 @@
 
 
 (define (mk-mvcall p c)
-  (record-case p
+  (struct-case p
     [(funcall) (make-mvcall p c)]
     [(seq e0 e1)
      (make-seq e0 (mk-mvcall e1 c))]
@@ -1057,7 +1057,7 @@
   (define who 'copy-propagate)
   (define the-void (make-constant (void)))
   (define (known-value x) 
-    (record-case x 
+    (struct-case x 
       [(constant) x] ; known
       [(primref)  x] ; known
       [(bind lhs* rhs* body) (known-value body)]
@@ -1076,7 +1076,7 @@
                  (primref-name y)))]
       [else #f]))
   (define (predicate-value x)
-    (record-case x
+    (struct-case x
       [(constant t) (if t 't 'f)]
       [(bind lhs rhs body) (predicate-value body)]
       [(fix lhs rhs body) (predicate-value body)]
@@ -1148,13 +1148,13 @@
   (define (do-clambda g cls* free name)
     (make-clambda g
       (map (lambda (cls)
-             (record-case cls
+             (struct-case cls
                [(clambda-case info body)
                 (make-clambda-case info (Value body))]))
            cls*)
       free name))
   (define (Effect x)
-    (record-case x
+    (struct-case x
       [(constant) the-void]
       [(var)      the-void]
       [(primref)  the-void]
@@ -1179,7 +1179,7 @@
          (cond
            [(known-value rator) =>
             (lambda (v)
-              (record-case v
+              (struct-case v
                 [(primref op)
                  (mk-seq rator
                     (optimize-primcall 'e op (map Value rand*)))]
@@ -1198,7 +1198,7 @@
            (Effect rhs))]
       [else (error who "invalid effect expression ~s" (unparse x))]))
   (define (Pred x)
-    (record-case x
+    (struct-case x
       [(constant) x]
       [(var) 
        (let ([r (var-referenced x)])
@@ -1237,7 +1237,7 @@
          (cond
            [(known-value rator) =>
             (lambda (v)
-              (record-case v
+              (struct-case v
                 [(primref op)
                  (mk-seq rator
                     (optimize-primcall 'p op (map Value rand*)))]
@@ -1252,7 +1252,7 @@
        (mk-mvcall (Value p) (Value c))]
       [else (error who "invalid pred expression ~s" (unparse x))]))
   (define (Value x)
-    (record-case x
+    (struct-case x
       [(constant) x]
       [(var) 
        (let ([r (var-referenced x)])
@@ -1289,7 +1289,7 @@
          (cond
            [(known-value rator) =>
             (lambda (v)
-              (record-case v
+              (struct-case v
                 [(primref op)
                  (mk-seq rator
                     (optimize-primcall 'v op (map Value rand*)))]
@@ -1331,7 +1331,7 @@
          (map (lambda (rhs) (make-funcall (make-primref 'vector) (list rhs))) rhs*)
          body)]))
   (define (Expr x)
-    (record-case x
+    (struct-case x
       [(constant) x]
       [(var) 
        (cond
@@ -1351,9 +1351,9 @@
       [(clambda g cls* free name) 
        (make-clambda g
          (map (lambda (cls)
-                (record-case cls
+                (struct-case cls
                   [(clambda-case info body)
-                   (record-case info
+                   (struct-case info
                      [(case-info label fml* proper)
                       (let-values ([(fml* a-lhs* a-rhs*) (fix-lhs* fml*)])
                         (make-clambda-case 
@@ -1383,7 +1383,7 @@
   (define (init-var x)
     (set-var-referenced! x #f))
   (define (set-var x v)
-    (record-case v
+    (struct-case v
       [(clambda) (set-var-referenced! x v)]
       [(var) 
        (cond
@@ -1394,7 +1394,7 @@
     (var-referenced x))
   (define (optimize c rator rand*)
     (let ([n (length rand*)])
-      (record-case c
+      (struct-case c
         [(clambda main-label cls*)
          (let f ([cls* cls*])
            (cond
@@ -1402,7 +1402,7 @@
               ;;; none matching?
               (make-funcall rator rand*)]
              [else
-              (record-case (clambda-case-info (car cls*))
+              (struct-case (clambda-case-info (car cls*))
                 [(case-info label fml* proper)
                  (cond
                    [proper
@@ -1421,7 +1421,7 @@
                                       (f (cdr fml*) (cdr rand*)))])))
                         (f (cdr cls*)))])])]))])))
   (define (Expr x)
-    (record-case x
+    (struct-case x
       [(constant) x]
       [(var)      x]
       [(primref)  x]
@@ -1439,7 +1439,7 @@
       [(clambda g cls* free name) 
        (make-clambda g
          (map (lambda (cls)
-                (record-case cls
+                (struct-case cls
                   [(clambda-case info body)
                    (for-each init-var (case-info-args info))
                    (make-clambda-case info (Expr body))]))
@@ -1484,14 +1484,14 @@
                     [(d d-free) (do-clambda* (cdr x*))])
          (values (cons a d) (union a-free d-free)))]))
   (define (do-clambda x)
-    (record-case x 
+    (struct-case x 
       [(clambda g cls* _free name)
        (let-values ([(cls* free) 
                      (let f ([cls* cls*])
                        (cond
                          [(null? cls*) (values '() '())]
                          [else
-                          (record-case (car cls*)
+                          (struct-case (car cls*)
                             [(clambda-case info body)
                              (let-values ([(body body-free) (Expr body)]
                                           [(cls* cls*-free) (f (cdr cls*))])
@@ -1502,7 +1502,7 @@
           (values (make-closure (make-clambda g cls* free name) free)
                   free))]))
   (define (Expr ex)
-    (record-case ex
+    (struct-case ex
       [(constant) (values ex '())]
       [(var) (values ex (singleton ex))]
       [(primref) (values ex '())]
@@ -1544,7 +1544,7 @@
       [(mvcall p c)
        (let-values ([(p p-free) (Expr p)]
                     [(c c-free) (Expr c)])
-         (record-case c
+         (struct-case c
            [(closure code free^) 
             (values (make-mvcall p code)
                     (union p-free c-free))]
@@ -1574,16 +1574,16 @@
   (define (make-thunk-var var thunk)
     (set-var-referenced! var thunk))
   (define (thunk? x)
-    (record-case x
+    (struct-case x
       [(closure code free*)
        (null? free*)]
       [else #f]))
   (define (trim/lift-code code free*)
-    (record-case code
+    (struct-case code
       [(clambda label cls* free*/dropped name)
        (let ([cls* (map
                      (lambda (x)
-                       (record-case x 
+                       (struct-case x 
                          [(clambda-case info body)
                           (for-each init-non-thunk
                               (case-info-args info))
@@ -1617,7 +1617,7 @@
     (for-each init-non-thunk lhs*)
     (let ([free** ;;; trim the free lists first; after init.
            (map (lambda (x) (trim-vars (closure-free* x))) rhs*)])
-      (define-record node (name code deps whacked free))
+      (define-struct node (name code deps whacked free))
       (let ([node* (map (lambda (lhs rhs) 
                           (let ([n (make-node lhs (closure-code rhs) '() #f '())])
                             (make-thunk-var lhs n)
@@ -1679,7 +1679,7 @@
                     (trim-thunks rhs*)
                     (E body))))))
   (define (E x)
-    (record-case x
+    (struct-case x
       [(constant) x]
       [(var)      (or (var-thunk x) x)]
       [(primref)  x]
@@ -1693,12 +1693,12 @@
       [(funcall rator rand*) (make-funcall (E rator) (map E rand*))]
       [(jmpcall label rator rand*) (make-jmpcall label (E rator) (map E rand*))]
       [(mvcall p c)
-       (record-case c 
+       (struct-case c 
          [(clambda label cases free name)
           (make-mvcall (E p) 
             (make-clambda label
               (map (lambda (x)
-                     (record-case x
+                     (struct-case x
                        [(clambda-case info body)
                         (make-clambda-case info (E body))]))
                    cases)
@@ -1718,15 +1718,15 @@
         (make-funcall (make-primref '$do-event) '()))
       x))
   (define (CaseExpr x)
-    (record-case x 
+    (struct-case x 
       [(clambda-case info body)
        (make-clambda-case info (Tail body))]))
   (define (CodeExpr x)
-    (record-case x
+    (struct-case x
       [(clambda L cases free name)
        (make-clambda L (map CaseExpr cases) free name)]))
   (define (CodesExpr x)
-    (record-case x 
+    (struct-case x 
       [(codes list body)
        (make-codes (map CodeExpr list) (Tail body))]))
   (CodesExpr x))
@@ -1886,8 +1886,8 @@
   (define tcbucket-size      16)
   (define record-ptag  5)
   (define record-pmask 7)
-  (define disp-record-rtd     0)
-  (define disp-record-data    4)
+  (define disp-struct-rtd     0)
+  (define disp-struct-data    4)
   (define disp-frame-size -17)
   (define disp-frame-offset -13)
   (define disp-multivalue-rp -9)

src/ikarus.fasl.ss

@@ -43,7 +43,7 @@
   (import (ikarus)
           (except (ikarus code-objects) procedure-annotation)
           (ikarus system $codes)
-          (ikarus system $records))
+          (ikarus system $structs))
 
   (define who 'fasl-read)
   (define (assert-eq? x y)
@@ -218,18 +218,18 @@
                         [else 
                          (let ([a (read)])
                            (cons a (f (fxadd1 i))))]))])
-               (let ([rtd (make-record-type 
+               (let ([rtd (make-struct-type 
                             rtd-name fields rtd-symbol)])
                  (when m (put-mark m rtd))
                  rtd)))]
           [(#\{)
            (let ([n (read-int p)])
              (let ([rtd (read)])
-               (let ([x ($make-record rtd n)])
+               (let ([x ($make-struct rtd n)])
                  (when m (put-mark m x))
                  (let f ([i 0])
                    (unless (fx= i n)
-                     (record-set! x i (read))
+                     ($struct-set! x i (read))
                      (f (fxadd1 i))))
                  x)))]
           [(#\C)

src/ikarus.fasl.write.ss

@@ -5,7 +5,7 @@
     (rnrs hashtables)
     (ikarus system $codes)
     (ikarus system $pairs)
-    (ikarus system $records)
+    (ikarus system $structs)
     (ikarus system $io)
     (ikarus system $bytevectors)
     (ikarus system $fx)
@@ -139,16 +139,16 @@
                (write-byte (code-ref x i) p)
                (f (fxadd1 i) n)))
            (fasl-write-object (code-reloc-vector x) p h m))]
-        [(record? x)
-         (let ([rtd (record-type-descriptor x)])
+        [(struct? x)
+         (let ([rtd (struct-type-descriptor x)])
            (cond
              [(eq? rtd (base-rtd))
               ;;; rtd record
               (write-char #\R p)
-              (let ([names (record-type-field-names x)]
+              (let ([names (struct-type-field-names x)]
                     [m 
-                     (fasl-write-object (record-type-symbol x) p h
-                       (fasl-write-object (record-type-name x) p h m))])
+                     (fasl-write-object (struct-type-symbol x) p h
+                       (fasl-write-object (struct-type-name x) p h m))])
                 (write-int (length names) p)
                 (let f ([names names] [m m])
                   (cond
@@ -159,15 +159,15 @@
              [else
               ;;; non-rtd record
               (write-char #\{ p)
-              (write-int (length (record-type-field-names rtd)) p)
-              (let f ([names (record-type-field-names rtd)] 
+              (write-int (length (struct-type-field-names rtd)) p)
+              (let f ([names (struct-type-field-names rtd)] 
                       [m (fasl-write-object rtd p h m)])
                 (cond
                   [(null? names) m]
                   [else
                    (f (cdr names) 
                       (fasl-write-object 
-                         ((record-field-accessor rtd (car names)) x)
+                         ((struct-field-accessor rtd (car names)) x)
                          p h m))]))]))]
         [(procedure? x)
          (write-char #\Q p)
@@ -253,24 +253,24 @@
              [(code? x) 
               (make-graph ($code-annotation x) h)
               (make-graph (code-reloc-vector x) h)]
-             [(record? x)
+             [(struct? x)
               (when (eq? x (base-rtd))
                 (error 'fasl-write "base-rtd is not writable"))
-              (let ([rtd (record-type-descriptor x)])
+              (let ([rtd (struct-type-descriptor x)])
                 (cond
                   [(eq? rtd (base-rtd))
                    ;;; this is an rtd
-                   (make-graph (record-type-name x) h)
-                   (make-graph (record-type-symbol x) h)
+                   (make-graph (struct-type-name x) h)
+                   (make-graph (struct-type-symbol x) h)
                    (for-each (lambda (x) (make-graph x h))
-                     (record-type-field-names x))]
+                     (struct-type-field-names x))]
                   [else
                    ;;; this is a record
                    (make-graph rtd h)
                    (for-each 
                      (lambda (name) 
-                       (make-graph ((record-field-accessor rtd name) x) h))
-                     (record-type-field-names rtd))]))]
+                       (make-graph ((struct-field-accessor rtd name) x) h))
+                     (struct-type-field-names rtd))]))]
              [(procedure? x)
               (let ([code ($closure-code x)])
                 (unless (fxzero? (code-freevars code))

src/ikarus.hash-tables.ss

@@ -14,7 +14,7 @@
              hashtable-update! hashtable-keys hashtable-mutable?
              hashtable-clear!))
 
-   (define-record hasht (vec count tc mutable?))
+   (define-struct hasht (vec count tc mutable?))
 
   ;;; directly from Dybvig's paper
   (define tc-pop

src/ikarus.pretty-print.ss

@@ -13,11 +13,11 @@
          (cons a (map1ltr f (cdr ls))))]))
   (define (pretty-width) 80)
   (define (pretty-indent) 1)
-  (define-record cbox (length boxes))
-  (define-record pbox (length ls last))
-  (define-record mbox (length str val))
-  (define-record vbox (length ls))
-  (define-record fbox (length box* sep*))
+  (define-struct cbox (length boxes))
+  (define-struct pbox (length ls last))
+  (define-struct mbox (length str val))
+  (define-struct vbox (length ls))
+  (define-struct fbox (length box* sep*))
   (define (box-length x)
     (cond
       [(string? x) (string-length x)]
@@ -511,8 +511,8 @@
         (dynamic x))
     rv)
 
-  (define-record setbox (idx data))
-  (define-record refbox (idx))
+  (define-struct setbox (idx data))
+  (define-struct refbox (idx))
 
   (define (rewrite-shared x h)
     (define counter 0)
@@ -608,7 +608,7 @@
   (set-fmt! 'define '(_ name tab e tab e ...))
   (set-fmt! 'case-lambda 
      '(_ tab [0 e ...] ...))
-  (set-fmt! 'record-case 
+  (set-fmt! 'struct-case 
      '(_ e tab [e 0 e ...] ...))
   (set-fmt! 'if '(_ test 3 e ...))
   (set-fmt! 'and '(and test 4 e ...))

src/ikarus.reader.ss

@@ -962,7 +962,7 @@
           [else
            (let-values ([(a locs k) (parse-token p locs k t)])
               (read-bytevector p locs k (fxadd1 count) (cons a ls)))]))))
-  (define-record loc (value set?))
+  (define-struct loc (value set?))
   (define parse-token
     (lambda (p locs k t)
       (cond

src/ikarus.records.ss

@@ -1,273 +0,0 @@
-
-
-(library (ikarus records)
-  (export
-    make-record-type record-type-name record-type-symbol
-    record-type-field-names record-constructor record-predicate
-    record-field-accessor record-field-mutator record? record-rtd
-    set-rtd-printer!
-    (rename (record-rtd record-type-descriptor)) 
-    record-name record-printer record-length record-ref record-set!)
-
-  (import
-    (ikarus system $records)
-    (ikarus system $pairs)
-    (ikarus system $fx)
-    (except (ikarus)
-      make-record-type record-type-name record-type-symbol
-      record-type-field-names record-constructor record-predicate
-      record-field-accessor record-field-mutator record? record-rtd
-      record-type-descriptor record-name record-printer record-length
-      record-ref record-set! set-rtd-printer!))
-
-
-
-  (define rtd?
-    (lambda (x)
-      (and ($record? x)
-           (eq? ($record-rtd x) (base-rtd)))))
-
-  (define rtd-name
-    (lambda (rtd)
-      ($record-ref rtd 0)))
-
-  (define rtd-length
-    (lambda (rtd)
-      ($record-ref rtd 1)))
-
-  (define rtd-fields
-    (lambda (rtd)
-      ($record-ref rtd 2)))
-
-  (define rtd-printer
-    (lambda (rtd)
-      ($record-ref rtd 3)))
-
-  (define rtd-symbol
-    (lambda (rtd)
-      ($record-ref rtd 4)))
-
-  (define set-rtd-name!
-    (lambda (rtd name)
-      ($record-set! rtd 0 name)))
- 
-  (define set-rtd-length!
-    (lambda (rtd n)
-      ($record-set! rtd 1 n)))
-
-  (define set-rtd-fields!
-    (lambda (rtd fields)
-      ($record-set! rtd 2 fields)))
-
-  (define $set-rtd-printer!
-    (lambda (rtd printer)
-      ($record-set! rtd 3 printer)))
-   
-  (define set-rtd-symbol!
-    (lambda (rtd symbol)
-      ($record-set! rtd 4 symbol)))
-
-  (define make-rtd
-    (lambda (name fields printer symbol)
-      ($record (base-rtd) name (length fields) fields printer symbol)))
-
-  (define verify-field
-    (lambda (x)
-      (unless (symbol? x) 
-        (error 'make-record-type "~s is not a valid field name" x))))
-  
-  (define set-fields
-    (lambda (r f* i n)
-      (cond
-        [(null? f*)
-         (if ($fx= i n)
-             r
-             #f)]
-        [($fx< i n)
-         (if (null? f*)
-             #f
-             (begin
-               ($record-set! r i ($car f*))
-               (set-fields r ($cdr f*) ($fxadd1 i) n)))]
-        [else #f])))
-
-  (define make-record-type
-    (case-lambda
-      [(name fields)
-       (unless (string? name)
-         (error 'make-record-type "name must be a string, got ~s" name))
-       (unless (list? fields)
-         (error 'make-record-type "fields must be a list, got ~s" fields))
-       (for-each verify-field fields)
-       (let ([g (gensym name)])
-         (let ([rtd (make-rtd name fields #f g)])
-           (set-symbol-value! g rtd)
-           rtd))]
-      [(name fields g)
-       (unless (string? name)
-         (error 'make-record-type "name must be a string, got ~s" name))
-       (unless (list? fields)
-         (error 'make-record-type "fields must be a list, got ~s" fields))
-       (for-each verify-field fields)
-       (cond
-         [(symbol-bound? g)
-          (let ([rtd (symbol-value g)])
-            (unless (and (string=? name (record-type-name rtd))
-                         (equal? fields (record-type-field-names rtd)))
-              (error 'make-record-type "definition mismatch"))
-            rtd)]
-         [else
-          (let ([rtd (make-rtd name fields #f g)])
-            (set-symbol-value! g rtd)
-            rtd)])]))
-
-  (define record-type-name
-    (lambda (rtd)
-      (unless (rtd? rtd)
-        (error 'record-type-name "~s is not an rtd" rtd))
-      (rtd-name rtd)))
-
-  (define record-type-symbol
-    (lambda (rtd)
-      (unless (rtd? rtd)
-        (error 'record-type-symbol "~s is not an rtd" rtd))
-      (rtd-symbol rtd)))
-  
-  (define record-type-field-names
-    (lambda (rtd)
-      (unless (rtd? rtd)
-        (error 'record-type-field-names "~s is not an rtd" rtd))
-      (rtd-fields rtd)))
- 
-
-  (define record-constructor
-    (lambda (rtd)
-      (unless (rtd? rtd)
-        (error 'record-constructor "~s is not an rtd"))
-      (lambda args
-        (let ([n (rtd-length rtd)])
-          (let ([r ($make-record rtd n)])
-            (or (set-fields r args 0 n)
-                (error 'record-constructor 
-                  "incorrect number of arguments to the constructor of ~s" 
-                  rtd)))))))
-  
-  (define record-predicate
-    (lambda (rtd)
-      (unless (rtd? rtd)
-        (error 'record-predicate "~s is not an rtd"))
-      (lambda (x)
-        (and ($record? x)
-             (eq? ($record-rtd x) rtd)))))
-
-  (define field-index 
-    (lambda (i rtd who)
-      (cond
-        [(fixnum? i)
-         (unless (and ($fx>= i 0) ($fx< i (rtd-length rtd)))
-           (error who "~s is out of range for rtd ~s" rtd))
-         i]
-        [(symbol? i)
-         (letrec ([lookup
-                   (lambda (n ls)
-                     (cond
-                       [(null? ls) 
-                        (error who "~s is not a field in ~s" rtd)]
-                       [(eq? i ($car ls)) n]
-                       [else (lookup ($fx+ n 1) ($cdr ls))]))])
-           (lookup 0 (rtd-fields rtd)))]
-        [else (error who "~s is not a valid index" i)])))
-
-  (define record-field-accessor
-    (lambda (rtd i)
-      (unless (rtd? rtd)
-        (error 'record-field-accessor "~s is not an rtd" rtd))
-      (let ([i (field-index i rtd 'record-field-accessor)])
-        (lambda (x)
-          (unless (and ($record? x) 
-                       (eq? ($record-rtd x) rtd))
-            (error 'record-field-accessor "~s is not of type ~s" x rtd))
-          ($record-ref x i)))))
-
-  (define record-field-mutator
-    (lambda (rtd i)
-      (unless (rtd? rtd)
-        (error 'record-field-mutator "~s is not an rtd" rtd))
-      (let ([i (field-index i rtd 'record-field-mutator)])
-        (lambda (x v)
-          (unless (and ($record? x) 
-                       (eq? ($record-rtd x) rtd))
-            (error 'record-field-mutator "~s is not of type ~s" x rtd))
-          ($record-set! x i v)))))
-
-  (define record?
-    (lambda (x . rest)
-      (if (null? rest)
-          ($record? x)
-          (let ([rtd ($car rest)])
-            (unless (null? ($cdr rest))
-              (error 'record? "too many arguments"))
-            (unless (rtd? rtd)
-              (error 'record? "~s is not an rtd"))
-            (and ($record? x)
-                 (eq? ($record-rtd x) rtd))))))
-
-  (define record-rtd
-    (lambda (x)
-      (if ($record? x)
-          ($record-rtd x)
-          (error 'record-rtd "~s is not a record" x))))
-
-  (define record-length
-    (lambda (x)
-      (if ($record? x)
-          (rtd-length ($record-rtd x))
-          (error 'record-length "~s is not a record" x))))
-            
-  (define record-name
-    (lambda (x)
-      (if ($record? x)
-          (rtd-name ($record-rtd x))
-          (error 'record-name "~s is not a record" x))))
-
-  (define record-printer
-    (lambda (x)
-      (if ($record? x)
-          (rtd-printer ($record-rtd x))
-          (error 'record-printer "~s is not a record" x))))
-
-  (define record-ref
-    (lambda (x i)
-      (unless ($record? x) (error 'record-ref "~s is not a record" x))
-      (unless (fixnum? i) (error 'record-ref "~s is not a valid index" i))
-      (let ([n (rtd-length ($record-rtd x))])
-        (unless (and ($fx>= i 0) ($fx< i n))
-          (error 'record-ref "index ~s is out of range for ~s" i x))
-        ($record-ref x i))))
-
-  (define record-set!
-    (lambda (x i v)
-      (unless ($record? x) (error 'record-set! "~s is not a record" x))
-      (unless (fixnum? i) (error 'record-set! "~s is not a valid index" i))
-      (let ([n (rtd-length ($record-rtd x))])
-        (unless (and ($fx>= i 0) ($fx< i n))
-          (error 'record-set! "index ~s is out of range for ~s" i x))
-        ($record-set! x i v))))
-
-  (define (set-rtd-printer! x p)
-    (unless (rtd? x)
-      (error 'set-rtd-printer! "~s is not an rtd" x))
-    (unless (procedure? p)
-      (error 'set-rtd-printer! "~s is not a procedure" p))
-    ($set-rtd-printer! x p))
-
-  (set-rtd-fields! (base-rtd) '(name fields length printer symbol))
-  (set-rtd-name! (base-rtd) "base-rtd")
-  ($set-rtd-printer! (base-rtd)
-    (lambda (x p)
-      (unless (rtd? x)
-        (error 'record-type-printer "not an rtd"))
-      (display "#<" p)
-      (display (rtd-name x) p)
-      (display " rtd>" p)))
-  )

src/ikarus.singular-objects.ss

@@ -3,7 +3,7 @@
   (export base-rtd eof-object void fixnum-width least-fixnum
           greatest-fixnum)
   (import 
-    (rename (ikarus system $records) (base-rtd sys:base-rtd))
+    (rename (ikarus system $structs) (base-rtd sys:base-rtd))
     (rename (ikarus)
             (void sys:void)
             (fixnum-width sys:fixnum-width)

src/ikarus.structs.ss

@@ -0,0 +1,273 @@
+
+
+(library (ikarus structs)
+  (export
+    make-struct-type struct-type-name struct-type-symbol
+    struct-type-field-names struct-constructor struct-predicate
+    struct-field-accessor struct-field-mutator struct? struct-rtd
+    set-rtd-printer!
+    (rename (struct-rtd struct-type-descriptor))
+    struct-name struct-printer struct-length struct-ref struct-set!)
+
+  (import
+    (ikarus system $structs)
+    (ikarus system $pairs)
+    (ikarus system $fx)
+    (except (ikarus)
+      make-struct-type struct-type-name struct-type-symbol
+      struct-type-field-names struct-constructor struct-predicate
+      struct-field-accessor struct-field-mutator struct? struct-rtd
+      struct-type-descriptor struct-name struct-printer struct-length
+      struct-ref struct-set! set-rtd-printer!))
+
+
+
+  (define rtd?
+    (lambda (x)
+      (and ($struct? x)
+           (eq? ($struct-rtd x) (base-rtd)))))
+
+  (define rtd-name
+    (lambda (rtd)
+      ($struct-ref rtd 0)))
+
+  (define rtd-length
+    (lambda (rtd)
+      ($struct-ref rtd 1)))
+
+  (define rtd-fields
+    (lambda (rtd)
+      ($struct-ref rtd 2)))
+
+  (define rtd-printer
+    (lambda (rtd)
+      ($struct-ref rtd 3)))
+
+  (define rtd-symbol
+    (lambda (rtd)
+      ($struct-ref rtd 4)))
+
+  (define set-rtd-name!
+    (lambda (rtd name)
+      ($struct-set! rtd 0 name)))
+ 
+  (define set-rtd-length!
+    (lambda (rtd n)
+      ($struct-set! rtd 1 n)))
+
+  (define set-rtd-fields!
+    (lambda (rtd fields)
+      ($struct-set! rtd 2 fields)))
+
+  (define $set-rtd-printer!
+    (lambda (rtd printer)
+      ($struct-set! rtd 3 printer)))
+   
+  (define set-rtd-symbol!
+    (lambda (rtd symbol)
+      ($struct-set! rtd 4 symbol)))
+
+  (define make-rtd
+    (lambda (name fields printer symbol)
+      ($struct (base-rtd) name (length fields) fields printer symbol)))
+
+  (define verify-field
+    (lambda (x)
+      (unless (symbol? x) 
+        (error 'make-struct-type "~s is not a valid field name" x))))
+  
+  (define set-fields
+    (lambda (r f* i n)
+      (cond
+        [(null? f*)
+         (if ($fx= i n)
+             r
+             #f)]
+        [($fx< i n)
+         (if (null? f*)
+             #f
+             (begin
+               ($struct-set! r i ($car f*))
+               (set-fields r ($cdr f*) ($fxadd1 i) n)))]
+        [else #f])))
+
+  (define make-struct-type
+    (case-lambda
+      [(name fields)
+       (unless (string? name)
+         (error 'make-struct-type "name must be a string, got ~s" name))
+       (unless (list? fields)
+         (error 'make-struct-type "fields must be a list, got ~s" fields))
+       (for-each verify-field fields)
+       (let ([g (gensym name)])
+         (let ([rtd (make-rtd name fields #f g)])
+           (set-symbol-value! g rtd)
+           rtd))]
+      [(name fields g)
+       (unless (string? name)
+         (error 'make-struct-type "name must be a string, got ~s" name))
+       (unless (list? fields)
+         (error 'make-struct-type "fields must be a list, got ~s" fields))
+       (for-each verify-field fields)
+       (cond
+         [(symbol-bound? g)
+          (let ([rtd (symbol-value g)])
+            (unless (and (string=? name (struct-type-name rtd))
+                         (equal? fields (struct-type-field-names rtd)))
+              (error 'make-struct-type "definition mismatch"))
+            rtd)]
+         [else
+          (let ([rtd (make-rtd name fields #f g)])
+            (set-symbol-value! g rtd)
+            rtd)])]))
+
+  (define struct-type-name
+    (lambda (rtd)
+      (unless (rtd? rtd)
+        (error 'struct-type-name "~s is not an rtd" rtd))
+      (rtd-name rtd)))
+
+  (define struct-type-symbol
+    (lambda (rtd)
+      (unless (rtd? rtd)
+        (error 'struct-type-symbol "~s is not an rtd" rtd))
+      (rtd-symbol rtd)))
+  
+  (define struct-type-field-names
+    (lambda (rtd)
+      (unless (rtd? rtd)
+        (error 'struct-type-field-names "~s is not an rtd" rtd))
+      (rtd-fields rtd)))
+ 
+
+  (define struct-constructor
+    (lambda (rtd)
+      (unless (rtd? rtd)
+        (error 'struct-constructor "~s is not an rtd"))
+      (lambda args
+        (let ([n (rtd-length rtd)])
+          (let ([r ($make-struct rtd n)])
+            (or (set-fields r args 0 n)
+                (error 'struct-constructor 
+                  "incorrect number of arguments to the constructor of ~s" 
+                  rtd)))))))
+  
+  (define struct-predicate
+    (lambda (rtd)
+      (unless (rtd? rtd)
+        (error 'struct-predicate "~s is not an rtd"))
+      (lambda (x)
+        (and ($struct? x)
+             (eq? ($struct-rtd x) rtd)))))
+
+  (define field-index 
+    (lambda (i rtd who)
+      (cond
+        [(fixnum? i)
+         (unless (and ($fx>= i 0) ($fx< i (rtd-length rtd)))
+           (error who "~s is out of range for rtd ~s" rtd))
+         i]
+        [(symbol? i)
+         (letrec ([lookup
+                   (lambda (n ls)
+                     (cond
+                       [(null? ls) 
+                        (error who "~s is not a field in ~s" rtd)]
+                       [(eq? i ($car ls)) n]
+                       [else (lookup ($fx+ n 1) ($cdr ls))]))])
+           (lookup 0 (rtd-fields rtd)))]
+        [else (error who "~s is not a valid index" i)])))
+
+  (define struct-field-accessor
+    (lambda (rtd i)
+      (unless (rtd? rtd)
+        (error 'struct-field-accessor "~s is not an rtd" rtd))
+      (let ([i (field-index i rtd 'struct-field-accessor)])
+        (lambda (x)
+          (unless (and ($struct? x) 
+                       (eq? ($struct-rtd x) rtd))
+            (error 'struct-field-accessor "~s is not of type ~s" x rtd))
+          ($struct-ref x i)))))
+
+  (define struct-field-mutator
+    (lambda (rtd i)
+      (unless (rtd? rtd)
+        (error 'struct-field-mutator "~s is not an rtd" rtd))
+      (let ([i (field-index i rtd 'struct-field-mutator)])
+        (lambda (x v)
+          (unless (and ($struct? x) 
+                       (eq? ($struct-rtd x) rtd))
+            (error 'struct-field-mutator "~s is not of type ~s" x rtd))
+          ($struct-set! x i v)))))
+
+  (define struct?
+    (lambda (x . rest)
+      (if (null? rest)
+          ($struct? x)
+          (let ([rtd ($car rest)])
+            (unless (null? ($cdr rest))
+              (error 'struct? "too many arguments"))
+            (unless (rtd? rtd)
+              (error 'struct? "~s is not an rtd"))
+            (and ($struct? x)
+                 (eq? ($struct-rtd x) rtd))))))
+
+  (define struct-rtd
+    (lambda (x)
+      (if ($struct? x)
+          ($struct-rtd x)
+          (error 'struct-rtd "~s is not a struct" x))))
+
+  (define struct-length
+    (lambda (x)
+      (if ($struct? x)
+          (rtd-length ($struct-rtd x))
+          (error 'struct-length "~s is not a struct" x))))
+            
+  (define struct-name
+    (lambda (x)
+      (if ($struct? x)
+          (rtd-name ($struct-rtd x))
+          (error 'struct-name "~s is not a struct" x))))
+
+  (define struct-printer
+    (lambda (x)
+      (if ($struct? x)
+          (rtd-printer ($struct-rtd x))
+          (error 'struct-printer "~s is not a struct" x))))
+
+  (define struct-ref
+    (lambda (x i)
+      (unless ($struct? x) (error 'struct-ref "~s is not a struct" x))
+      (unless (fixnum? i) (error 'struct-ref "~s is not a valid index" i))
+      (let ([n (rtd-length ($struct-rtd x))])
+        (unless (and ($fx>= i 0) ($fx< i n))
+          (error 'struct-ref "index ~s is out of range for ~s" i x))
+        ($struct-ref x i))))
+
+  (define struct-set!
+    (lambda (x i v)
+      (unless ($struct? x) (error 'struct-set! "~s is not a struct" x))
+      (unless (fixnum? i) (error 'struct-set! "~s is not a valid index" i))
+      (let ([n (rtd-length ($struct-rtd x))])
+        (unless (and ($fx>= i 0) ($fx< i n))
+          (error 'struct-set! "index ~s is out of range for ~s" i x))
+        ($struct-set! x i v))))
+
+  (define (set-rtd-printer! x p)
+    (unless (rtd? x)
+      (error 'set-rtd-printer! "~s is not an rtd" x))
+    (unless (procedure? p)
+      (error 'set-rtd-printer! "~s is not a procedure" p))
+    ($set-rtd-printer! x p))
+
+  (set-rtd-fields! (base-rtd) '(name fields length printer symbol))
+  (set-rtd-name! (base-rtd) "base-rtd")
+  ($set-rtd-printer! (base-rtd)
+    (lambda (x p)
+      (unless (rtd? x)
+        (error 'struct-type-printer "not an rtd"))
+      (display "#<" p)
+      (display (rtd-name x) p)
+      (display " rtd>" p)))
+  )

src/ikarus.timer.ss

@@ -3,7 +3,7 @@
   (export time-it)
   (import (except (ikarus) time-it))
 
-  (define-record stats 
+  (define-struct stats 
     (user-secs user-usecs 
      sys-secs sys-usecs 
      real-secs real-usecs

src/ikarus.writer.ss

@@ -119,12 +119,12 @@
       (write-char #\) p)
       i))
 
-  (define write-record
+  (define write-struct
     (lambda (x p m h i)
       (write-char #\# p)
       (write-char #\[ p)
-      (let ([i (writer (record-name x) p m h i)])
-        (let ([n (record-length x)])
+      (let ([i (writer (struct-name x) p m h i)])
+        (let ([n (struct-length x)])
           (let f ([idx 0] [i i])
             (cond
               [(fx= idx n)
@@ -133,7 +133,7 @@
               [else 
                (write-char #\space p)
                (f (fxadd1 idx) 
-                  (writer (record-ref x idx) p m h i))]))))))
+                  (writer (struct-ref x idx) p m h i))]))))))
   
   (define initial?
     (lambda (c)
@@ -546,11 +546,11 @@
         [(hashtable? x)
          (write-char* "#<hashtable>" p)
          i]
-        [(record? x)
-         (let ([printer (record-printer x)])
+        [(struct? x)
+         (let ([printer (struct-printer x)])
            (if (procedure? printer)
                (begin (printer x p) i)
-               (write-shareable x p m h i write-record)))]
+               (write-shareable x p m h i write-struct)))]
         [(code? x)
          (write-char* "#<code>" p)]
         [($unbound-object? x)

src/makefile.ss

@@ -37,7 +37,7 @@
     "ikarus.lists.ss"
     "ikarus.fixnums.ss"
     "ikarus.chars.ss"
-    "ikarus.records.ss"
+    "ikarus.structs.ss"
     "ikarus.strings.ss"
     "ikarus.transcoders.ss"
     "ikarus.date-string.ss"
@@ -104,7 +104,7 @@
     [parameterize        (core-macro . parameterize)]
     [case                (core-macro . case)]
     [let-values          (core-macro . let-values)]
-    [define-record       (macro . define-record)]
+    [define-struct       (macro . define-struct)]
     [include             (macro . include)]
     [syntax-rules        (macro . syntax-rules)]
     [quasiquote          (macro . quasiquote)]
@@ -193,7 +193,7 @@
     [$fx         (ikarus system $fx)                   #f     #t]
     [$rat        (ikarus system $ratnums)              #f     #t]
     [$symbols    (ikarus system $symbols)              #f     #t]
-    [$records    (ikarus system $records)              #f     #t]
+    [$structs    (ikarus system $structs)              #f     #t]
     [$ports      (ikarus system $ports)                #f     #t]
     [$codes      (ikarus system $codes)                #f     #t]
     [$tcbuckets  (ikarus system $tcbuckets)            #f     #t]
@@ -211,7 +211,7 @@
     [foreign-call                                i]
     [type-descriptor                             i]
     [parameterize                                i parameters]
-    [define-record                               i]
+    [define-struct                               i]
     [include                                     i r]
     [time                                        i]
     [trace-lambda                                i]
@@ -310,16 +310,19 @@
     [environment?                                i]
     [time-it                                     i]
     [command-line-arguments                      i]
-    [make-record-type                            i]
-    [record-type-symbol                          i]
     [set-rtd-printer!                            i]
-    [record-name                                 i]
-    [record-length                               i]
-    [record-printer                              i]
-    [record-ref                                  i]
-    [record-set!                                 i]
-    [record-field-accessor                       i]
-    [record-field-mutator                        i]
+    [make-record-type                            i]
+    [struct?                                     i]
+    [make-struct-type                            i]
+    [struct-type-name                            i]
+    [struct-type-symbol                          i]
+    [struct-type-field-names                     i]
+    [struct-field-accessor                       i]
+    [struct-length                               i]
+    [struct-ref                                  i]
+    [struct-printer                              i]
+    [struct-name                                 i]
+    [struct-type-descriptor                      i]
     [code?                                       i]
     [immediate?                                  i]
     [pointer-value                               i]
@@ -413,14 +416,16 @@
     [$set-symbol-plist!                          $symbols]
     [$init-symbol-value!                         ]
     [$unbound-object?                            $symbols]
-    [base-rtd                                    $records]
-    [$record-set!                                $records]
-    [$record-ref                                 $records]
-    [$record-rtd                                 $records]
-    [$record                                     $records]
-    [$make-record                                $records]
-    [$record?                                    $records]
-    [$record/rtd?                                $records]
+    
+    [base-rtd                                    $structs]
+    [$struct-set!                                $structs]
+    [$struct-ref                                 $structs]
+    [$struct-rtd                                 $structs]
+    [$struct                                     $structs]
+    [$make-struct                                $structs]
+    [$struct?                                    $structs]
+    [$struct/rtd?                                $structs]
+
     [$make-port/input                            $ports]
     [$make-port/output                           $ports]
     [$port-handler                               $ports]
@@ -1129,25 +1134,25 @@
     [parent-rtd                                  i r rs]
     [protocol                                    i r rs]
     [record-constructor-descriptor               r rs]
-    [record-type-descriptor                      i r rs]
+    [record-type-descriptor                      r rs]
     [sealed                                      i r rs]
     [nongenerative                               i r rs]
     [record-field-mutable?                       r ri]
     [record-rtd                                  r ri]
-    [record-type-field-names                     i r ri]
+    [record-type-field-names                     r ri]
     [record-type-generative?                     r ri]
-    [record-type-name                            i r ri]
+    [record-type-name                            r ri]
     [record-type-opaque?                         r ri]
     [record-type-parent                          r ri]
     [record-type-sealed?                         r ri]
     [record-type-uid                             r ri]
-    [record?                                     i r ri]
+    [record?                                     r ri]
     [make-record-constructor-descriptor          r rp]
     [make-record-type-descriptor                 r rp]
     [record-accessor                             r rp]
-    [record-constructor                          i r rp]
+    [record-constructor                          r rp]
     [record-mutator                              r rp]
-    [record-predicate                            i r rp]
+    [record-predicate                            r rp]
     [record-type-descriptor?                     r rp]
     [bound-identifier=?                          i r sc]
     [datum->syntax                               i r sc]
@@ -1246,6 +1251,20 @@
       [() set]
       [(x) (set! set (cons x set))])))
 
+(define (assq1 x ls)
+  (let f ([x x] [ls ls] [p #f])
+    (cond
+      [(null? ls) p]
+      [(eq? x (caar ls)) 
+       (if p
+           (if (pair? p) 
+               (if (eq? (cdr p) (cdar ls))
+                   (f x (cdr ls) p)
+                   (f x (cdr ls) 2))
+               (f x (cdr ls) (+ p 1)))
+           (f x (cdr ls) (car ls)))]
+      [else (f x (cdr ls) p)])))
+      
 (define (make-system-data subst env)
   (define who 'make-system-data)
   (let ([export-subst    (make-collection)] 
@@ -1264,9 +1283,11 @@
           (cond
             [(assq x (export-subst))
              (error who "ambiguous export of ~s" x)]
-            [(assq x subst) =>
+            [(assq1 x subst) =>
              ;;; primitive defined (exported) within the compiled libraries
              (lambda (p)
+               (unless (pair? p) 
+                 (error who "~s exports of ~s" p x))
                (let ([label (cdr p)])
                  (cond
                    [(assq label env) =>

src/pass-specify-rep-primops.ss

@@ -38,7 +38,7 @@
      (K dirty-word)))
 
 (define (smart-dirty-vector-set addr what)
-  (record-case what
+  (struct-case what
     [(constant t) 
      (if (or (fixnum? t) (immediate? t))
          (prm 'nop)
@@ -52,7 +52,7 @@
       (dirty-vector-set t))))
 
 (define (smart-mem-assign what v x i)
-  (record-case what
+  (struct-case what
     [(constant t) 
      (if (or (fixnum? t) (immediate? t))
          (prm 'mset x (K i) v)
@@ -150,7 +150,7 @@
 
 (define-primop $memq safe
   [(P x ls)
-   (record-case ls
+   (struct-case ls
      [(constant ls)
       (cond
         [(not (list? ls)) (interrupt)]
@@ -167,7 +167,7 @@
                   (f (cdr ls)))])))])]
      [else (interrupt)])]
   [(V x ls)
-   (record-case ls
+   (struct-case ls
      [(constant ls)
       (cond
         [(not (list? ls)) (interrupt)]
@@ -311,7 +311,7 @@
             (interrupt-unless (prm 'u< (T idx) len))
             (with-tmp ([t (prm 'logor len (T idx))])
               (interrupt-unless-fixnum t)))))
-      (record-case idx
+      (struct-case idx
         [(constant i)
          (if (and (fixnum? i) (fx>= i 0)) 
              (check-fx i)
@@ -325,7 +325,7 @@
 
 (define-primop $make-vector unsafe
   [(V len)
-   (record-case len
+   (struct-case len
      [(constant i)
       (unless (fixnum? i) (interrupt))
       (with-tmp ([v (prm 'alloc
@@ -346,7 +346,7 @@
 (define-primop $vector-ref unsafe
   [(V x i)
    (or 
-     (record-case i
+     (struct-case i
        [(constant i) 
         (and (fixnum? i) 
              (fx>= i 0)
@@ -387,7 +387,7 @@
 
 (define-primop $vector-set! unsafe
   [(E x i v)
-   (record-case i
+   (struct-case i
      [(constant i) 
       (unless (fixnum? i) (interrupt)) 
       (mem-assign v (T x) 
@@ -433,7 +433,7 @@
 
 (define-primop $cpref unsafe
   [(V x i) 
-   (record-case i
+   (struct-case i
      [(constant i) 
       (unless (fixnum? i) (interrupt))
       (prm 'mref (T x)
@@ -502,7 +502,7 @@
 
 (define-primop top-level-value safe
   [(V x)
-   (record-case x
+   (struct-case x
      [(constant s)
       (if (symbol? s)
           (with-tmp ([v (cogen-value-$symbol-value x)])
@@ -516,7 +516,7 @@
           (interrupt-when (cogen-pred-$unbound-object? v))
           v))])]
   [(E x)
-   (record-case x
+   (struct-case x
      [(constant s)
       (if (symbol? s)
           (with-tmp ([v (cogen-value-$symbol-value x)])
@@ -607,12 +607,12 @@
 
 (define-primop $fx* unsafe
   [(V a b) 
-   (record-case a
+   (struct-case a
     [(constant a)
      (unless (fixnum? a) (interrupt))
      (prm 'int* (T b) (K a))]
     [else
-     (record-case b
+     (struct-case b
        [(constant b)
         (unless (fixnum? b) (interrupt))
         (prm 'int* (T a) (K b))]
@@ -648,7 +648,7 @@
 
 (define-primop $fxsll unsafe
   [(V x i)
-   (record-case i
+   (struct-case i
      [(constant i) 
       (unless (fixnum? i) (interrupt))
       (prm 'sll (T x) (K i))]
@@ -659,7 +659,7 @@
 
 (define-primop $fxsra unsafe
   [(V x i)
-   (record-case i
+   (struct-case i
      [(constant i) 
       (unless (fixnum? i) (interrupt))
       (prm 'logand 
@@ -744,7 +744,7 @@
 
 (define-primop $bignum-byte-ref unsafe
   [(V s i)
-   (record-case i
+   (struct-case i
      [(constant i)
       (unless (fixnum? i) (interrupt))
       (prm 'sll
@@ -799,7 +799,7 @@
 
 (define-primop $flonum-u8-ref unsafe
   [(V s i)
-   (record-case i
+   (struct-case i
      [(constant i)
       (unless (and (fixnum? i) (fx<= 0 i) (fx<= i 7))
         (interrupt))
@@ -823,7 +823,7 @@
 
 (define-primop $flonum-set! unsafe
   [(E x i v)
-   (record-case i
+   (struct-case i
      [(constant i)
       (unless (and (fixnum? i) (fx<= 0 i) (fx<= i 7))
         (interrupt))
@@ -892,7 +892,7 @@
 (section ;;; generic arithmetic
 
 (define (non-fixnum? x)
-  (record-case x
+  (struct-case x
     [(constant i) (not (fixnum? i))]
     [else #f]))
 
@@ -1019,7 +1019,7 @@
 
 (define-primop quotient safe
   [(V x n) 
-   (record-case n
+   (struct-case n
     [(constant i) 
      (if (eqv? i 2) 
          (seq* 
@@ -1039,13 +1039,13 @@
 
 /section)
 
-(section ;;; records
+(section ;;; structs
 
-(define-primop $record? unsafe
+(define-primop $struct? unsafe
   [(P x) (sec-tag-test (T x) vector-mask vector-tag vector-mask vector-tag)]
   [(E x) (nop)])
 
-(define-primop $record/rtd? unsafe
+(define-primop $struct/rtd? unsafe
   [(P x rtd)
    (make-conditional
      (tag-test (T x) vector-mask vector-tag)
@@ -1053,36 +1053,36 @@
      (make-constant #f))]
   [(E x rtd) (nop)])
 
-(define-primop $make-record unsafe
+(define-primop $make-struct unsafe
   [(V rtd len)
-   (record-case len
+   (struct-case len
      [(constant i) 
       (unless (fixnum? i) (interrupt))
       (with-tmp ([t (prm 'alloc
-                         (K (align (+ (* i wordsize) disp-record-data)))
+                         (K (align (+ (* i wordsize) disp-struct-data)))
                          (K vector-tag))])
-        (prm 'mset t (K (- disp-record-rtd vector-tag)) (T rtd))
+        (prm 'mset t (K (- disp-struct-rtd vector-tag)) (T rtd))
         t)]
      [else
-      (with-tmp ([ln (align-code len disp-record-data)])
+      (with-tmp ([ln (align-code len disp-struct-data)])
         (with-tmp ([t (prm 'alloc ln (K vector-tag))])
-          (prm 'mset t (K (- disp-record-rtd vector-tag)) (T rtd))
+          (prm 'mset t (K (- disp-struct-rtd vector-tag)) (T rtd))
            t))])]
   [(P rtd len) (K #t)]
   [(E rtd len) (nop)])
 
-(define-primop $record-rtd unsafe
+(define-primop $struct-rtd unsafe
   [(V x) 
-   (prm 'mref (T x) (K (- disp-record-rtd vector-tag)))]
+   (prm 'mref (T x) (K (- disp-struct-rtd vector-tag)))]
   [(E x) (nop)]
   [(P x) #t])
 
-(define-primop $record-ref unsafe
+(define-primop $struct-ref unsafe
   [(V x i) (cogen-value-$vector-ref x i)]
   [(E x i) (cogen-effect-$vector-ref x i)]
   [(P x i) (cogen-pred-$vector-ref x i)])
 
-(define-primop $record-set! unsafe
+(define-primop $struct-set! unsafe
   [(V x i v) 
    (seq* (cogen-effect-$vector-set! x i v) 
          (K void-object))]
@@ -1091,16 +1091,16 @@
    (seq* (cogen-effect-$vector-set! x i v)
          (K #t))])
 
-(define-primop $record unsafe
+(define-primop $struct unsafe
   [(V rtd . v*)
    (with-tmp ([t (prm 'alloc 
                      (K (align
-                          (+ disp-record-data
+                          (+ disp-struct-data
                             (* (length v*) wordsize))))
                      (K vector-tag))])
-     (prm 'mset t (K (- disp-record-rtd vector-tag)) (T rtd))
+     (prm 'mset t (K (- disp-struct-rtd vector-tag)) (T rtd))
      (let f ([v* v*] 
-             [i (- disp-record-data vector-tag)])
+             [i (- disp-struct-data vector-tag)])
        (cond
          [(null? v*) t]
          [else
@@ -1112,6 +1112,8 @@
 
 /section)
 
+
+
 (section ;;; characters
 
 (define-primop char? safe
@@ -1152,7 +1154,7 @@
   [(E x) (nop)])
 
 (define (non-char? x)
-  (record-case x
+  (struct-case x
     [(constant i) (not (char? i))]
     [else #f]))
 
@@ -1227,7 +1229,7 @@
 
 (define-primop $make-bytevector unsafe
   [(V n)
-   (record-case n
+   (struct-case n
      [(constant n)
       (unless (fixnum? n) (interrupt))
       (with-tmp ([s (prm 'alloc 
@@ -1265,7 +1267,7 @@
 
 (define-primop $bytevector-u8-ref unsafe
   [(V s i)
-   (record-case i
+   (struct-case i
      [(constant i)
       (unless (fixnum? i) (interrupt))
       (prm 'sll
@@ -1288,7 +1290,7 @@
 
 (define-primop $bytevector-s8-ref unsafe
   [(V s i)
-   (record-case i
+   (struct-case i
      [(constant i)
       (unless (fixnum? i) (interrupt))
       (prm 'sra
@@ -1314,10 +1316,10 @@
 
 (define-primop $bytevector-set! unsafe
   [(E x i c)
-   (record-case i
+   (struct-case i
      [(constant i) 
       (unless (fixnum? i) (interrupt))
-      (record-case c
+      (struct-case c
         [(constant c)
          (unless (fixnum? c) (interrupt))
          (prm 'bset/c (T x)
@@ -1331,7 +1333,7 @@
                (K (+ i (- disp-bytevector-data bytevector-tag)))
                (prm 'sll (T c) (K (- 8 fx-shift))))])]
      [else
-      (record-case c
+      (struct-case c
         [(constant c)
          (unless (fixnum? c) (interrupt))
          (prm 'bset/c (T x) 
@@ -1359,7 +1361,7 @@
 
 (define-primop $make-string unsafe
   [(V n)
-   (record-case n
+   (struct-case n
      [(constant n)
       (unless (fixnum? n) (interrupt))
       (with-tmp ([s (prm 'alloc 
@@ -1388,7 +1390,7 @@
 
 (define-primop $string-ref unsafe
   [(V s i)
-   (record-case i
+   (struct-case i
      [(constant i)
       (unless (fixnum? i) (interrupt))
       (prm 'mref (T s)
@@ -1402,13 +1404,13 @@
   [(E s i) (nop)])
 
 (define (assert-fixnum x)
-  (record-case x
+  (struct-case x
     [(constant i) 
      (if (fixnum? i) (nop) (interrupt))]
     [else (interrupt-unless (cogen-pred-fixnum? x))]))
 
 (define (assert-string x)
-  (record-case x
+  (struct-case x
     [(constant s) (if (string? s) (nop) (interrupt))]
     [else (interrupt-unless (cogen-pred-string? x))]))
 
@@ -1434,7 +1436,7 @@
 
 (define-primop $string-set! unsafe
   [(E x i c)
-   (record-case i
+   (struct-case i
      [(constant i) 
       (unless (fixnum? i) (interrupt))
       (prm 'mset (T x) 

src/pass-specify-rep.ss

@@ -31,7 +31,7 @@
 (module (specify-representation)
   (import object-representation)
   (import primops)
-  (define-record PH
+  (define-struct PH
     (interruptable? p-handler p-handled? v-handler v-handled? e-handler e-handled?))
   (define interrupt-handler
     (make-parameter (lambda () (error 'interrupt-handler "uninitialized"))))
@@ -66,21 +66,21 @@
              [(not interrupted?) body]
              [(eq? ctxt 'V)
               (let ([h (make-interrupt-call x args)])
-                (if (record-case body
+                (if (struct-case body
                       [(primcall op) (eq? op 'interrupt)]
                       [else #f])
                      (make-no-interrupt-call x args)
                      (make-shortcut body h)))]
              [(eq? ctxt 'E)
               (let ([h (make-interrupt-call x args)])
-                (if (record-case body
+                (if (struct-case body
                       [(primcall op) (eq? op 'interrupt)]
                       [else #f])
                      (make-no-interrupt-call x args)
                      (make-shortcut body h)))]
              [(eq? ctxt 'P)
               (let ([h (prm '!= (make-interrupt-call x args) (K bool-f))])
-                (if (record-case body
+                (if (struct-case body
                       [(primcall op) (eq? op 'interrupt)]
                       [else #f])
                      (prm '!= (make-no-interrupt-call x args) (K bool-f))
@@ -132,7 +132,7 @@
          (make-bind lhs* rhs* (k args))])))
   (define (cogen-primop x ctxt args)
     (define (interrupt? x)
-      (record-case x
+      (struct-case x
         [(primcall x) (eq? x 'interrupt)]
         [else #f]))
     (let ([p (get-primop x)])
@@ -235,7 +235,7 @@
 
   (define (handle-fix lhs* rhs* body)
     (define (closure-size x)
-      (record-case x
+      (struct-case x
         [(closure code free*) 
          (if (null? free*) 
              0
@@ -254,7 +254,7 @@
              [else 
               (values a* b* (cons x c*) (cons y d*))]))]))
     (define (combinator? lhs rhs)
-      (record-case rhs
+      (struct-case rhs
         [(closure code free*) (null? free*)]))
     (define (sum n* n)
       (cond
@@ -279,7 +279,7 @@
               body)))))
     (define (build-setters lhs* rhs* body)
       (define (build-setter lhs rhs body)
-        (record-case rhs
+        (struct-case rhs
           [(closure code free*) 
            (make-seq
              (prm 'mset lhs 
@@ -325,7 +325,7 @@
         [else (make-constant (make-object c))])))
 
   (define (V x)
-    (record-case x
+    (struct-case x
       [(constant) (constant-rep x)]
       [(var)      x]
       [(primref name)  
@@ -353,7 +353,7 @@
       [else (error 'cogen-V "invalid value expr ~s" x)])) 
 
   (define (P x)
-    (record-case x
+    (struct-case x
       [(constant c) (if c (K #t) (K #f))]
       [(primref)  (K #t)]
       [(code-loc) (K #t)]
@@ -375,7 +375,7 @@
       [else (error 'cogen-P "invalid pred expr ~s" x)])) 
   
   (define (E x)
-    (record-case x
+    (struct-case x
       [(constant) (nop)]
       [(var)      (nop)]
       [(primref)  (nop)]
@@ -411,12 +411,12 @@
             x)
           (V (make-funcall (make-primref 'error)
                (list (K 'apply) (K "~s is not a procedure") x))))))
-    (record-case x
+    (struct-case x
        [(primcall op args)
         (cond
           [(and (eq? op 'top-level-value)
                 (= (length args) 1)
-                (record-case (car args)
+                (struct-case (car args)
                   [(constant t) 
                    (and (symbol? t) t)]
                   [else #f])) =>
@@ -449,19 +449,19 @@
 
 
   (define (T x)
-    (record-case x
+    (struct-case x
       [(var) x]
       [(constant i) (constant-rep x)]
       [else (error 'cogen-T "invalid ~s" (unparse x))]))
 
   (define (ClambdaCase x)
-    (record-case x
+    (struct-case x
       [(clambda-case info body)
        (make-clambda-case info (V body))]
       [else (error 'specify-rep "invalid clambda-case ~s" x)]))
   ;;;
   (define (Clambda x)
-    (record-case x
+    (struct-case x
       [(clambda label case* free* name)
        (make-clambda label 
           (map ClambdaCase case*)
@@ -469,7 +469,7 @@
       [else (error 'specify-rep "invalid clambda ~s" x)]))
   ;;;
   (define (Program x)
-    (record-case x 
+    (struct-case x 
       [(codes code* body)
        (let ([code* (map Clambda code*)]
              [body (V body)])

src/psyntax.compat.ss

@@ -1,20 +1,20 @@
 
 (library (psyntax compat)
   (export define-record make-parameter parameterize format gensym
-          eval-core make-record-type symbol-value set-symbol-value!
-          file-options-spec)
+          eval-core symbol-value set-symbol-value!
+          file-options-spec make-struct-type)
   (import 
     (only (ikarus compiler) eval-core)
-    (rename (ikarus) (define-record sys.define-record)))
+    (ikarus))
 
   (define-syntax define-record
     (syntax-rules ()
       [(_ name (field* ...) printer)
        (begin
-         (sys.define-record name (field* ...))
+         (define-struct name (field* ...))
          (module ()
             (set-rtd-printer! (type-descriptor name)
               printer)))]
       [(_ name (field* ...))
-       (sys.define-record name (field* ...))])))
+       (define-struct name (field* ...))])))
 

src/psyntax.config.ss

@@ -19,7 +19,8 @@
 ;;; DEALINGS IN THE SOFTWARE. 
 
 (library (psyntax config)
-  (export if-wants-define-record if-wants-case-lambda
+  (export if-wants-define-record if-wants-define-struct 
+          if-wants-case-lambda
           if-wants-letrec* if-wants-global-defines)
   (import (rnrs))
   (define-syntax define-option
@@ -34,6 +35,7 @@
            ((_ sk fk) fk))))))
   
   (define-option if-wants-define-record  #t)
+  (define-option if-wants-define-struct  #t)
   ;;; define-record is an ikarus-specific extension.
   ;;; should be disabled for all other implementations
   ;;; the source is included to illustrate how

src/psyntax.expander.ss

@@ -1325,8 +1325,9 @@
                 `(syntax-case (list ,@rhs*) ()
                    (,lhs* (syntax ,v))))))))))
 
-  (define define-record-macro
-    (if-wants-define-record
+
+  (define define-struct-macro
+    (if-wants-define-struct
       (lambda (e)
         (define enumerate
           (lambda (ls)
@@ -1342,7 +1343,7 @@
            (let* ((namestr (symbol->string (id->sym name)))
                   (fields (map id->sym field*))
                   (fieldstr* (map symbol->string fields))
-                  (rtd (datum->stx name (make-record-type namestr fields)))
+                  (rtd (datum->stx name (make-struct-type namestr fields)))
                   (constr (mkid name (string-append "make-" namestr)))
                   (pred (mkid name (string-append namestr "?")))
                   (i* (enumerate field*))
@@ -1359,29 +1360,30 @@
                   (define-syntax ,name (cons '$rtd ',rtd))
                   (define ,constr
                     (lambda ,field*
-                      ($record ',rtd ,@field*)))
+                      ($struct ',rtd ,@field*)))
                   (define ,pred
-                    (lambda (x) ($record/rtd? x ',rtd)))
+                    (lambda (x) ($struct/rtd? x ',rtd)))
                   ,@(map (lambda (getter i)
                             `(define ,getter
                                (lambda (x)
-                                 (if ($record/rtd? x ',rtd)
-                                     ($record-ref x ,i)
+                                 (if ($struct/rtd? x ',rtd)
+                                     ($struct-ref x ,i)
                                      (error ',getter
-                                            "~s is not a record of type ~s"
+                                            "~s is not a struct of type ~s"
                                             x ',rtd)))))
                          getters i*)
                   ,@(map (lambda (setter i)
                             `(define ,setter
                                (lambda (x v)
-                                 (if ($record/rtd? x ',rtd)
-                                     ($record-set! x ,i v)
+                                 (if ($struct/rtd? x ',rtd)
+                                     ($struct-set! x ,i v)
                                      (error ',setter
-                                            "~s is not a record of type ~s"
+                                            "~s is not a struct of type ~s"
                                             x ',rtd)))))
                          setters i*)))))))
       (lambda (stx)
-        (stx-error stx "define-record not supported"))))
+        (stx-error stx "define-struct not supported"))))
+
   
   (define incorrect-usage-macro
     (lambda (e) (stx-error e "incorrect usage of auxilary keyword")))
@@ -1899,7 +1901,7 @@
         ((procedure? x) x)
         ((symbol? x)
          (case x
-           ((define-record)     define-record-macro)
+           ((define-struct)     define-struct-macro)
            ((include)           include-macro)
            ((cond)              cond-macro)
            ((let)               let-macro)