* `hack-fastmap' needed to call `syntax-table/entries' because
authorChris Hanson <org/chris-hanson/cph>
Fri, 5 Oct 1990 23:54:51 +0000 (23:54 +0000)
committerChris Hanson <org/chris-hanson/cph>
Fri, 5 Oct 1990 23:54:51 +0000 (23:54 +0000)
the syntax-table abstraction has changed since it was written.

* Fixed bug in `re-disassemble-pattern' that showed the wrong syntax
  class for syntax operators.

v7/src/runtime/rgxcmp.scm

index 53838d434cb9e2276f372c04e60f15018a09c87a..65b1306da6b40b88007a5926ea08fd729c1b3993 100644 (file)
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/rgxcmp.scm,v 1.102 1989/08/14 09:22:56 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/rgxcmp.scm,v 1.103 1990/10/05 23:54:51 cph Rel $
 ;;;
-;;;    Copyright (c) 1986, 1989 Massachusetts Institute of Technology
+;;;    Copyright (c) 1986, 1989, 1990 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
 \f
 ;;;; Compiled Pattern Disassembler
 
-(define (hack-fastmap pat)
-  (let ((pattern (re-compile-pattern pat false))
+(define (hack-fastmap pattern)
+  (let ((compiled-pattern (re-compile-pattern pattern false))
        (cs (char-set)))
-    (re-disassemble-pattern pattern)
     ((ucode-primitive re-compile-fastmap)
-     pattern (re-translation-table false) (make-syntax-table) cs)
+     compiled-pattern
+     (re-translation-table false)
+     (syntax-table/entries (make-syntax-table))
+     cs)
     (char-set-members cs)))
 
 (define (re-disassemble-pattern compiled-pattern)
             (loop (+ i 2)))
            ((SYNTAX-SPEC NOT-SYNTAX-SPEC)
             (write-string " ")
-            (write (string-ref " w_()'\"$\\/<>."
+            (write (string-ref " .w_()'\"$\\/<>"
                                (vector-8b-ref compiled-pattern (1+ i))))
             (write-string ")")
             (loop (+ i 2))))
-         (write-string "END)")))))
\ No newline at end of file
+         (begin
+           (write 'end)
+           (write-string ")"))))))
\ No newline at end of file