Improved error reports in records.procedural as per Derick

Eddington's suggestions and removed the record-name check for
non-generative records.

doc/ikarus-scheme-users-guide.tex

@@ -820,7 +820,7 @@ you need to specify that explicitly as in the following example.
 This definition gives us, in addition to the constructor, predicate,
 and accessors, two additional procedures:
 \begin{itemize}
-\item The mutators \texttt{set-point-x!} and \texttt{set-point-y!} that,
+\item The mutators \texttt{point-x-set!} and \texttt{point-y-set!} that,
 given a record of type point, and a new value, sets the value stored in the
 \texttt{x} field or \texttt{y} field to the new value.
 \end{itemize}

scheme/ikarus.records.procedural.ss

@@ -54,16 +54,14 @@
                 (not (rtd-opaque? rtd))))))
 
   (define (record-rtd x)
-    (define (err x)
-      (error 'record-rtd "not a record" x))
     (if ($struct? x)
         (let ([rtd ($struct-rtd x)])
           (if (rtd? rtd)
               (if (not (rtd-opaque? rtd))
                   rtd
-                  (err x))
-              (err x)))
-        (err x)))
+                  (error 'record-rtd "record is opaque"))
+              (error 'record-rtd "not a record" x)))
+        (error 'record-rtd "not a record" x)))
 
   (define (record-type-name x)
     (if (rtd? x)
@@ -179,7 +177,8 @@
           [(lookup-rtd uid) =>
            (lambda (rtd) 
              (unless
-               (and (eqv? name (rtd-name rtd))
+               (and ; must not check name!
+                    ; (eqv? name (rtd-name rtd)) 
                     (eqv? parent (rtd-parent rtd))
                     (eqv? sealed? (rtd-sealed? rtd))
                     (eqv? opaque? (rtd-opaque? rtd))

scheme/ikarus.sort.ss

@@ -20,7 +20,7 @@
     (ikarus system $fx)
     (except (ikarus) list-sort vector-sort vector-sort!))
   
-
+  (module (sort-tail)
     (define (merge1 <? a1 ls1 ls2) 
       (cond
         [(null? ls2) ls1]
@@ -72,13 +72,16 @@
         [else
          (let-values ([(sorted-head tail) 
                        (sort-head <? ls ($fxsra n 1))])
-          (merge <? sorted-head (sort-tail <? tail ($fx- n ($fxsra n 1)))))]))
+            (merge <? sorted-head 
+              (sort-tail <? tail ($fx- n ($fxsra n 1)))))])))
 
   (define (list-sort <? ls) 
     (unless (procedure? <?)
       (error 'list-sort "not a procedure" <?))
     (sort-tail <? ls (length ls)))
 
+
+
   (define (vector-sort <? v)
     ;;; FIXME: improve
     (unless (procedure? <?)
@@ -89,6 +92,8 @@
       (sort-tail <? (vector->list v) (vector-length v))))
 
   (define (vector-sort! <? v) 
+    (import (ikarus system $vectors))
+    (import (ikarus system $pairs))
     (unless (procedure? <?)
       (error 'vector-sort! "not a procedure" <?))
     (unless (vector? v)
@@ -96,8 +101,8 @@
     (let f ([i 0] [v v] 
             [ls (sort-tail <? (vector->list v) (vector-length v))])
       (unless (null? ls) 
-        (vector-set! v i (car ls))
-        (f (fx+ i 1) v (cdr ls)))))
+        ($vector-set! v i ($car ls))
+        (f ($fx+ i 1) v ($cdr ls)))))
     
   )
 

scheme/last-revision

@@ -1 +1 @@
-1160
+1162

scheme/pass-specify-rep-primops.ss

@@ -60,19 +60,20 @@
          (dirty-vector-set addr))]
     [else (dirty-vector-set addr)]))
 
-(define (mem-assign v x i)
+
+(define (slow-mem-assign v x i)
   (with-tmp ([t (prm 'int+ x (K i))])
     (make-seq 
       (prm 'mset t (K 0) (T v))
       (dirty-vector-set t))))
 
-(define (smart-mem-assign what v x i)
-  (struct-case what
+(define (mem-assign v x i)
+  (struct-case v
     [(constant t) 
      (if (or (fixnum? t) (immediate? t))
-         (prm 'mset x (K i) v)
-         (mem-assign v x i))]
-    [else (mem-assign v x i)]))
+         (prm 'mset x (K i) (T v))
+         (slow-mem-assign v x i))]
+    [else (slow-mem-assign v x i)]))
 
 (define (align-code unknown-amt known-amt)
   (prm 'sll