Optimize cpt-table-lookup

(Tweaked by Eli.)

collects/compiler/zo-parse.rkt

@@ -446,8 +446,8 @@
   r)
 
 (define small-list-max 65)
-(define cpt-table
+(define raw-cpt-table
-  ;; The "schcpt.h" mapping
+  ;; The "schcpt.h" mapping, earlier entries override later ones
   `([0  escape]
     [1  symbol]
     [2  symref]
@@ -496,14 +496,15 @@
     [249 small-application3]
     [247 255 small-application]))
 
-(define (cpt-table-lookup i)
+;; To accelerate cpt-table lookup, we flatten out the above
-  (for/or ([ent cpt-table])
+;; list into a vector:
-    (match ent
+(define cpt-table (make-vector 256 #f))
-      [(list k sym) (and (= k i) (cons k sym))]
+(for ([ent (in-list (reverse raw-cpt-table))])
-      [(list k k* sym)
+  ;; reverse order so that early entries override later ones.
-       (and (<= k i)
+  (match ent
-            (< i k*)
+    [(list k sym)    (vector-set! cpt-table k (cons k sym))]
-            (cons k sym))])))
+    [(list k k* sym) (for ([i (in-range k k*)])
+                       (vector-set! cpt-table i (cons k sym)))]))
 
 (define (read-compact-bytes port c)
   (begin0
@@ -783,9 +784,8 @@
   (let loop ([need-car 0] [proper #f])
     (define ch (cp-getc cp))
     (define-values (cpt-start cpt-tag)
-      (let ([x (cpt-table-lookup ch)])
+      (let ([x (vector-ref cpt-table ch)])
-        (unless x
+        (unless x (error 'read-compact "unknown code : ~a" ch))
-          (error 'read-compact "unknown code : ~a" ch))
         (values (car x) (cdr x))))
     (define v
       (case cpt-tag