Ticket #505: reader-restart-rec.diff.txt

File reader-restart-rec.diff.txt, 4.2 KB (added by Jim Ursetto, 14 years ago)

tail-call restart version

Line 
1diff --git a/chicken.import.scm b/chicken.import.scm
2index 9811d8f..512a5c1 100644
3--- a/chicken.import.scm
4+++ b/chicken.import.scm
5@@ -202,9 +202,12 @@
6    set-finalizer!
7    set-gc-report!
8    set-parameterized-read-syntax!
9+   set-parameterized-read-syntax!*
10    set-port-name!
11    set-read-syntax!
12+   set-read-syntax!*
13    set-sharp-read-syntax!
14+   set-sharp-read-syntax!*
15    setter
16    signal
17    signum
18diff --git a/library.scm b/library.scm
19index 31c8b37..0070e48 100644
20--- a/library.scm
21+++ b/library.scm
22@@ -2696,7 +2696,7 @@ EOF
23                 [h (and srst (##sys#slot srst (char->integer c)) ) ] )
24            (if h
25                ;then handled by read-table entry
26-               (h c port)
27+               (h c port readrec)
28                ;otherwise chicken extended r5rs syntax
29                (case c
30                  ((#\')
31@@ -2720,7 +2720,7 @@ EOF
32                                (spdrst (##sys#slot crt 3))
33                                (h (and spdrst (##sys#slot spdrst (char->integer dchar)) ) ) )
34                                 ;#<num> handled by parameterized # read-table entry?
35-                          (cond (h (h dchar port n))
36+                          (cond (h (h dchar port n readrec))
37                                 ;#<num>?
38                                 ((or (eq? dchar #\)) (char-whitespace? dchar)) (##sys#sharp-number-hook port n))
39                                 (else (##sys#read-error port "invalid parameterized read syntax" dchar n) ) ) )
40@@ -2728,7 +2728,7 @@ EOF
41                                (h (and sdrst (##sys#slot sdrst (char->integer dchar)) ) ) )
42                           (if h
43                               ;then handled by # read-table entry
44-                              (h dchar port)
45+                              (h dchar port readrec)
46                               ;otherwise chicken extended r5rs syntax
47                               (case (char-downcase dchar)
48                                 ((#\x) (##sys#read-char-0 port) (r-number-with-exactness 16))
49@@ -2903,8 +2903,11 @@ EOF
50        (set! read-marks (cons (cons sym proc) read-marks)) ) ) )
51 
52 (define set-read-syntax!)
53+(define set-read-syntax!*)
54 (define set-sharp-read-syntax!)
55+(define set-sharp-read-syntax!*)
56 (define set-parameterized-read-syntax!)
57+(define set-parameterized-read-syntax!*)
58 
59 (let ((crt current-read-table))
60 
61@@ -2923,25 +2926,49 @@ EOF
62     (syntax-setter
63      'set-read-syntax! 1
64      (lambda (proc)
65-       (lambda (_ port)
66+       (lambda (_ port restart)
67         (##sys#read-char-0 port)
68         (proc port) ) ) ) )
69 
70+  (set! set-read-syntax!*
71+    (syntax-setter
72+     'set-read-syntax!* 1
73+     (lambda (proc)
74+       (lambda (_ port restart)
75+        (##sys#read-char-0 port)
76+        (proc port restart) ) ) ) )
77+
78   (set! set-sharp-read-syntax!
79     (syntax-setter
80      'set-sharp-read-syntax! 2
81      (lambda (proc)
82-       (lambda (_ port)
83+       (lambda (_ port restart)
84         (##sys#read-char-0 port)
85         (proc port) ) ) ) )
86 
87+  (set! set-sharp-read-syntax!*
88+    (syntax-setter
89+     'set-sharp-read-syntax!* 2
90+     (lambda (proc)
91+       (lambda (_ port restart)
92+        (##sys#read-char-0 port)
93+        (proc port restart) ) ) ) )
94+
95   (set! set-parameterized-read-syntax!
96     (syntax-setter
97      'set-parameterized-read-syntax! 3
98      (lambda (proc)
99-       (lambda (_ port num)
100+       (lambda (_ port num restart)
101+        (##sys#read-char-0 port)
102+        (proc port num) ) ) ) )
103+
104+  (set! set-parameterized-read-syntax!*
105+    (syntax-setter
106+     'set-parameterized-read-syntax!* 3
107+     (lambda (proc)
108+       (lambda (_ port num restart)
109         (##sys#read-char-0 port)
110-        (proc port num) ) ) ) ) )
111+        (proc port num restart) ) ) ) ) )
112 
113 
114 ;;; Read-table operations:
115diff --git a/types.db b/types.db
116index 0f32e67..eb77658 100644
117--- a/types.db
118+++ b/types.db
119@@ -402,9 +402,12 @@
120 (set-finalizer! (procedure set-finalizer! (* (procedure (*) . *)) *))
121 (set-gc-report! (procedure set-gc-report! (*) undefined))
122 (set-parameterized-read-syntax! (procedure set-parameterized-read-syntax! (char procedure) undefined))
123+(set-parameterized-read-syntax!* (procedure set-parameterized-read-syntax!* (char procedure) undefined))
124 (set-port-name! (procedure set-port-name! (port string) undefined))
125 (set-read-syntax! (procedure set-read-syntax! (char procedure) undefined))
126+(set-read-syntax!* (procedure set-read-syntax!* (char procedure) undefined))
127 (set-sharp-read-syntax! (procedure set-sharp-read-syntax! (char procedure) undefined))
128+(set-sharp-read-syntax!* (procedure set-sharp-read-syntax!* (char procedure) undefined))
129 (setter (procedure setter (procedure) procedure))
130 (signal (procedure signal (*) . *))
131 (signum (procedure signum (number) number))