From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 2 Jul 2001 12:14:35 +0000 (+0000)
Subject: Replace WITH-CURRENT-POINTER and NO-POINTERS with new procedure
X-Git-Tag: 20090517-FFI~2681
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=d0a5ca637bb58007a00db91af6e810b02fed8ba0;p=mit-scheme.git

Replace WITH-CURRENT-POINTER and NO-POINTERS with new procedure
CALL-WITH-UNKNOWN-POINTER.  Change all references from "pointers" to
"pointer", since it's better to think of this as a single pointer.
(The delayed backtracking feature is an implementation detail, so it
shouldn't be reflected in the name.)  Rename NEW-BACKTRACK-POINTER to
BACKTRACK-TO.  Rename CURRENT-POINTER to POINTER-REFERENCE.
---

diff --git a/v7/src/star-parser/matcher.scm b/v7/src/star-parser/matcher.scm
index 2e90c5b7d..82cd8dc25 100644
--- a/v7/src/star-parser/matcher.scm
+++ b/v7/src/star-parser/matcher.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: matcher.scm,v 1.8 2001/07/02 05:08:16 cph Exp $
+;;; $Id: matcher.scm,v 1.9 2001/07/02 12:14:29 cph Exp $
 ;;;
 ;;; Copyright (c) 2001 Massachusetts Institute of Technology
 ;;;
@@ -50,12 +50,13 @@
 	  (lambda ()
 	    (maybe-make-let (map (lambda (b) (list (cdr b) (car b)))
 				 (cdr internal-bindings))
-			    (compile-matcher-expression expression
-				(no-pointers)
-			      (simple-backtracking-continuation `#T)
-			      (simple-backtracking-continuation `#F)))))))))
+	      (call-with-unknown-pointer
+	       (lambda (pointer)
+		 (compile-matcher-expression expression pointer
+		   (simple-backtracking-continuation `#T)
+		   (simple-backtracking-continuation `#F)))))))))))
 
-(define (compile-matcher-expression expression pointers if-succeed if-fail)
+(define (compile-matcher-expression expression pointer if-succeed if-fail)
   (cond ((and (pair? expression)
 	      (symbol? (car expression))
 	      (list? (cdr expression))
@@ -65,16 +66,16 @@
 		    (compiler (cdr entry)))
 		(if (and arity (not (= (length (cdr expression)) arity)))
 		    (error "Incorrect arity for matcher:" expression))
-		(apply compiler pointers if-succeed if-fail
+		(apply compiler pointer if-succeed if-fail
 		       (if arity
 			   (cdr expression)
 			   (list (cdr expression)))))))
 	((symbol? expression)
-	 (handle-pending-backtracking pointers
-	   (lambda (pointers)
+	 (handle-pending-backtracking pointer
+	   (lambda (pointer)
 	     `(IF (,expression ,*buffer-name*)
-		  ,(if-succeed (no-pointers))
-		  ,(if-fail pointers)))))
+		  ,(call-with-unknown-pointer if-succeed)
+		  ,(if-fail pointer)))))
 	(else
 	 (error "Malformed matcher:" expression))))
 
@@ -182,10 +183,10 @@
 	(parameters (cdr form)))
     (if (symbol? parameters)
 	`(DEFINE-MATCHER-COMPILER ',name #F
-	   (LAMBDA (POINTERS IF-SUCCEED IF-FAIL ,parameters)
+	   (LAMBDA (POINTER IF-SUCCEED IF-FAIL ,parameters)
 	     ,@compiler-body))
 	`(DEFINE-MATCHER-COMPILER ',name ,(length parameters)
-	   (LAMBDA (POINTERS IF-SUCCEED IF-FAIL ,@parameters)
+	   (LAMBDA (POINTER IF-SUCCEED IF-FAIL ,@parameters)
 	     ,@compiler-body)))))
 
 (define (define-matcher-compiler keyword arity compiler)
@@ -197,11 +198,11 @@
 
 (define-macro (define-atomic-matcher form test-expression)
   `(DEFINE-MATCHER ,form
-     (HANDLE-PENDING-BACKTRACKING POINTERS
-       (LAMBDA (POINTERS)
+     (HANDLE-PENDING-BACKTRACKING POINTER
+       (LAMBDA (POINTER)
 	 `(IF ,,test-expression
-	      ,(IF-SUCCEED (NO-POINTERS))
-	      ,(IF-FAIL POINTERS))))))
+	      ,(CALL-WITH-UNKNOWN-POINTER IF-SUCCEED)
+	      ,(IF-FAIL POINTER))))))
 
 (define-atomic-matcher (char char)
   `(MATCH-PARSER-BUFFER-CHAR ,*buffer-name* ,char))
@@ -225,59 +226,50 @@
   `(MATCH-PARSER-BUFFER-STRING-CI ,*buffer-name* ,string))
 
 (define-matcher (with-pointer identifier expression)
-  (with-current-pointer pointers
-    (lambda (pointers)
-      `(LET ((,identifier ,(current-pointer pointers)))
-	 ,(compile-matcher-expression expression pointers
-	    if-succeed if-fail)))))
+  `(LET ((,identifier ,(pointer-reference pointer)))
+     ,(compile-matcher-expression expression pointer if-succeed if-fail)))
 
 (define-matcher (* expression)
   if-fail
-  (handle-pending-backtracking pointers
-    (lambda (pointers)
-      pointers
-      (let ((pointers (no-pointers))
-	    (v (generate-uninterned-symbol)))
-	`(BEGIN
-	   (LET ,v ()
-	     ,(compile-matcher-expression expression pointers
-		(simple-backtracking-continuation `(,v))
-		(simple-backtracking-continuation `UNSPECIFIC)))
-	   ,(if-succeed pointers))))))
+  (handle-pending-backtracking pointer
+    (lambda (pointer)
+      pointer
+      (call-with-unknown-pointer
+       (lambda (pointer)
+	 (let ((v (generate-uninterned-symbol)))
+	   `(BEGIN
+	      (LET ,v ()
+		,(compile-matcher-expression expression pointer
+		   (simple-backtracking-continuation `(,v))
+		   (simple-backtracking-continuation `UNSPECIFIC)))
+	      ,(if-succeed pointer))))))))
 
 (define-matcher (seq . expressions)
-  (with-current-pointer pointers
-    (lambda (start)
-      (let loop
-	  ((expressions expressions)
-	   (pointers start))
-	(if (pair? expressions)
-	    (compile-matcher-expression (car expressions) pointers
-	      (lambda (pointers)
-		(loop (cdr expressions) pointers))
-	      (lambda (pointers)
-		(if-fail (new-backtrack-pointer start pointers))))
-	    (if-succeed pointers))))))
+  (let loop ((expressions expressions) (pointer* pointer))
+    (if (pair? expressions)
+	(compile-matcher-expression (car expressions) pointer*
+	  (lambda (pointer*)
+	    (loop (cdr expressions) pointer*))
+	  (lambda (pointer*)
+	    (if-fail (backtrack-to pointer pointer*))))
+	(if-succeed pointer*))))
 
 (define-matcher (alt . expressions)
   (cond ((not (pair? expressions))
-	 (if-fail pointers))
+	 (if-fail pointer))
 	((not (pair? (cdr expressions)))
-	 (compile-matcher-expression expression pointers if-succeed if-fail))
+	 (compile-matcher-expression expression pointer if-succeed if-fail))
 	(else
-	 (handle-pending-backtracking pointers
-	   (lambda (pointers)
-	     (with-current-pointer pointers
-	       (lambda (pointers)
-		 (let ((s (simple-backtracking-continuation '#T))
-		       (f (simple-backtracking-continuation '#F))))
-		 `(IF (OR ,@(map (lambda (expression)
-				   (compile-matcher-expression expression
-				       pointers
-				     s f))
-				 expressions))
-		      ,(if-succeed (no-pointers))
-		      ,(if-fail pointers)))))))))
+	 (handle-pending-backtracking pointer
+	   (lambda (pointer)
+	     `(IF (OR ,@(map (let ((s (simple-backtracking-continuation '#T))
+				   (f (simple-backtracking-continuation '#F)))
+			       (lambda (expression)
+				 (compile-matcher-expression expression pointer
+				   s f)))
+			     expressions))
+		  ,(call-with-unknown-pointer if-succeed)
+		  ,(if-fail pointer)))))))
 
 ;;; Edwin Variables:
 ;;; Eval: (scheme-indent-method 'handle-pending-backtracking 1)
diff --git a/v7/src/star-parser/parser.scm b/v7/src/star-parser/parser.scm
index 71391cf76..1463d3b80 100644
--- a/v7/src/star-parser/parser.scm
+++ b/v7/src/star-parser/parser.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: parser.scm,v 1.12 2001/07/02 05:08:19 cph Exp $
+;;; $Id: parser.scm,v 1.13 2001/07/02 12:14:32 cph Exp $
 ;;;
 ;;; Copyright (c) 2001 Massachusetts Institute of Technology
 ;;;
@@ -40,13 +40,13 @@
 (define (generate-parser-code expression)
   (with-canonical-parser-expression expression
     (lambda (expression)
-      (compile-parser-expression
-       expression
-       (no-pointers)
-       simple-backtracking-succeed
-       (simple-backtracking-continuation `#F)))))
+      (call-with-unknown-pointer
+       (lambda (pointer)
+	 (compile-parser-expression expression pointer
+	   simple-backtracking-succeed
+	   (simple-backtracking-continuation `#F)))))))
 
-(define (compile-parser-expression expression pointers if-succeed if-fail)
+(define (compile-parser-expression expression pointer if-succeed if-fail)
   (cond ((and (pair? expression)
 	      (symbol? (car expression))
 	      (list? (cdr expression))
@@ -56,26 +56,28 @@
 		    (compiler (cdr entry)))
 		(if (and arity (not (= (length (cdr expression)) arity)))
 		    (error "Incorrect arity for parser:" expression))
-		(apply compiler pointers if-succeed if-fail
+		(apply compiler pointer if-succeed if-fail
 		       (if arity
 			   (cdr expression)
 			   (list (cdr expression)))))))
 	((symbol? expression)
-	 (handle-pending-backtracking pointers
-	   (lambda (pointers)
+	 (handle-pending-backtracking pointer
+	   (lambda (pointer)
 	     (with-variable-binding `(,expression ,*buffer-name*)
 	       (lambda (result)
 		 `(IF ,result
-		      ,(if-succeed (no-pointers) result)
-		      ,(if-fail pointers)))))))
+		      ,(call-with-unknown-pointer
+			(lambda (pointer)
+			  (if-succeed pointer result)))
+		      ,(if-fail pointer)))))))
 	(else
 	 (error "Malformed matcher:" expression))))
 
 (define (backtracking-succeed handler)
-  (lambda (pointers result)
-    (handle-pending-backtracking pointers
-      (lambda (pointers)
-	pointers
+  (lambda (pointer result)
+    (handle-pending-backtracking pointer
+      (lambda (pointer)
+	pointer
 	(handler result)))))
 
 (define simple-backtracking-succeed
@@ -175,10 +177,10 @@
 	(parameters (cdr form)))
     (if (symbol? parameters)
 	`(DEFINE-PARSER-COMPILER ',name #F
-	   (LAMBDA (POINTERS IF-SUCCEED IF-FAIL ,parameters)
+	   (LAMBDA (POINTER IF-SUCCEED IF-FAIL ,parameters)
 	     ,@compiler-body))
 	`(DEFINE-PARSER-COMPILER ',name ,(length parameters)
-	   (LAMBDA (POINTERS IF-SUCCEED IF-FAIL ,@parameters)
+	   (LAMBDA (POINTER IF-SUCCEED IF-FAIL ,@parameters)
 	     ,@compiler-body)))))
 
 (define (define-parser-compiler keyword arity compiler)
@@ -189,130 +191,127 @@
   (make-eq-hash-table))
 
 (define-parser (match matcher)
-  (with-current-pointer pointers
-    (lambda (start)
-      (compile-matcher-expression matcher start
-	(lambda (pointers)
-	  (with-variable-binding
-	      `(VECTOR
-		(GET-PARSER-BUFFER-TAIL ,*buffer-name*
-					,(current-pointer start)))
-	    (lambda (v)
-	      (if-succeed pointers v))))
-	if-fail))))
+  (compile-matcher-expression matcher pointer
+    (lambda (pointer*)
+      (with-variable-binding
+	  `(VECTOR
+	    (GET-PARSER-BUFFER-TAIL ,*buffer-name*
+				    ,(pointer-reference pointer)))
+	(lambda (v)
+	  (if-succeed pointer* v))))
+    if-fail))
 
 (define-parser (noise matcher)
-  (compile-matcher-expression matcher pointers
-    (lambda (pointers) (if-succeed pointers `(VECTOR)))
+  (compile-matcher-expression matcher pointer
+    (lambda (pointer) (if-succeed pointer `(VECTOR)))
     if-fail))
 
 (define-parser (default value parser)
   if-fail
-  (compile-parser-expression parser pointers if-succeed
-    (lambda (pointers)
-      (if-succeed pointers `(VECTOR ,value)))))
+  (compile-parser-expression parser pointer if-succeed
+    (lambda (pointer)
+      (if-succeed pointer `(VECTOR ,value)))))
 
 (define-parser (transform transform parser)
-  (with-current-pointer pointers
-    (lambda (start)
-      (compile-parser-expression parser start
-	(lambda (pointers result)
-	  (with-variable-binding `(,transform ,result)
-	    (lambda (result)
-	      `(IF ,result
-		   ,(if-succeed pointers result)
-		   ,(if-fail (new-backtrack-pointer start pointers))))))
-	if-fail))))
+  (compile-parser-expression parser pointer
+    (lambda (pointer* result)
+      (with-variable-binding `(,transform ,result)
+	(lambda (result)
+	  `(IF ,result
+	       ,(if-succeed pointer* result)
+	       ,(if-fail (backtrack-to pointer pointer*))))))
+    if-fail))
 
 (define-parser (element-transform transform parser)
-  (compile-parser-expression parser pointers
-    (lambda (pointers result)
-      (if-succeed pointers `(VECTOR-MAP ,transform ,result)))
+  (compile-parser-expression parser pointer
+    (lambda (pointer result)
+      (if-succeed pointer `(VECTOR-MAP ,transform ,result)))
     if-fail))
 
 (define-parser (encapsulate transform parser)
-  (compile-parser-expression parser pointers
-    (lambda (pointers result)
-      (if-succeed pointers `(VECTOR (,transform ,result))))
+  (compile-parser-expression parser pointer
+    (lambda (pointer result)
+      (if-succeed pointer `(VECTOR (,transform ,result))))
     if-fail))
 
 (define-parser (complete parser)
-  (with-current-pointer pointers
-    (lambda (start)
-      (compile-parser-expression parser start
-	(lambda (pointers result)
-	  `(IF (PEEK-PARSER-BUFFER-CHAR ,*buffer-name*)
-	       ,(if-fail (new-backtrack-pointer start pointers))
-	       (BEGIN
-		 (DISCARD-PARSER-BUFFER-HEAD! ,*buffer-name*)
-		 ,(if-succeed pointers result))))
-	if-fail))))
+  (compile-parser-expression parser pointer
+    (lambda (pointer* result)
+      `(IF (PEEK-PARSER-BUFFER-CHAR ,*buffer-name*)
+	   ,(if-fail (backtrack-to pointer pointer*))
+	   (BEGIN
+	     (DISCARD-PARSER-BUFFER-HEAD! ,*buffer-name*)
+	     ,(if-succeed pointer* result))))
+    if-fail))
 
 (define-parser (top-level parser)
-  (compile-parser-expression parser pointers
-    (lambda (pointers result)
+  (compile-parser-expression parser pointer
+    (lambda (pointer result)
       `(BEGIN
 	 (DISCARD-PARSER-BUFFER-HEAD! ,*buffer-name*)
-	 ,(if-succeed pointers result)))
+	 ,(if-succeed pointer result)))
     if-fail))
 
 (define-parser (with-pointer identifier expression)
-  (with-current-pointer pointers
-    (lambda (pointers)
-      `(LET ((,identifier ,(current-pointer pointers)))
-	 ,(compile-parser-expression expression pointers
-	    if-succeed if-fail)))))
+  `(LET ((,identifier ,(pointer-reference pointer)))
+     ,(compile-parser-expression expression pointer
+	if-succeed if-fail)))
 
-(define-parser (seq . ps)
-  (if (pair? ps)
-      (if (pair? (cdr ps))
-	  (with-current-pointer pointers
-	    (lambda (start)
-	      (let loop ((ps ps) (pointers start) (results '()))
-		(compile-parser-expression (car ps) pointers
-		  (lambda (pointers result)
-		    (let ((results (cons result results)))
-		      (if (pair? (cdr ps))
-			  (loop (cdr ps) pointers results)
-			  (if-succeed pointers
-				      `(VECTOR-APPEND ,@(reverse results))))))
-		  (lambda (pointers)
-		    (if-fail (new-backtrack-pointer start pointers)))))))
-	  (compile-parser-expression (car ps) pointers if-succeed if-fail))
-      (if-succeed pointers `(VECTOR))))
+(define-parser (seq . expressions)
+  (if (pair? expressions)
+      (if (pair? (cdr expressions))
+	  (let loop
+	      ((expressions expressions)
+	       (pointer* pointer)
+	       (results '()))
+	    (compile-parser-expression (car expressions) pointer*
+	      (lambda (pointer* result)
+		(let ((results (cons result results)))
+		  (if (pair? (cdr expressions))
+		      (loop (cdr expressions) pointer* results)
+		      (if-succeed pointer*
+				  `(VECTOR-APPEND ,@(reverse results))))))
+	      (lambda (pointer*)
+		(if-fail (backtrack-to pointer pointer*)))))
+	  (compile-parser-expression (car expressions) pointer
+	    if-succeed
+	    if-fail))
+      (if-succeed pointer `(VECTOR))))
 
-(define-parser (alt . ps)
-  (handle-pending-backtracking pointers
-    (lambda (pointers)
-      (with-current-pointer pointers
-	(lambda (pointers)
-	  (with-variable-binding
-	      `(OR ,@(map (lambda (p)
-			    (compile-parser-expression p pointers
-			      simple-backtracking-succeed
-			      (simple-backtracking-continuation `#F)))
-			  ps))
-	    (lambda (result)
-	      `(IF ,result
-		   ,(if-succeed (no-pointers) result)
-		   ,(if-fail pointers)))))))))
+(define-parser (alt . expressions)
+  (handle-pending-backtracking pointer
+    (lambda (pointer)
+      (with-variable-binding
+	  `(OR ,@(map (lambda (expression)
+			(compile-parser-expression expression pointer
+			  simple-backtracking-succeed
+			  (simple-backtracking-continuation `#F)))
+		      expressions))
+	(lambda (result)
+	  `(IF ,result
+	       ,(call-with-unknown-pointer
+		 (lambda (pointer)
+		   (if-succeed pointer result)))
+	       ,(if-fail pointer)))))))
 
 (define-parser (* parser)
   if-fail
-  (handle-pending-backtracking pointers
-    (lambda (pointers)
-      pointers
-      (with-variable-binding
-	  (let ((loop (generate-uninterned-symbol))
-		(elements (generate-uninterned-symbol)))
-	    `(LET ,loop ((,elements (VECTOR)))
-	       ,(compile-parser-expression parser (no-pointers)
-		  (backtracking-succeed
-		   (lambda (element)
-		     `(,loop (VECTOR-APPEND ,elements ,element))))
-		  (simple-backtracking-continuation elements))))
-	(lambda (elements)
-	  (if-succeed (no-pointers) elements))))))
+  (handle-pending-backtracking pointer
+    (lambda (pointer)
+      pointer
+      (call-with-unknown-pointer
+       (lambda (pointer)
+	 (with-variable-binding
+	     (let ((loop (generate-uninterned-symbol))
+		   (elements (generate-uninterned-symbol)))
+	       `(LET ,loop ((,elements (VECTOR)))
+		  ,(compile-parser-expression parser pointer
+		     (backtracking-succeed
+		      (lambda (element)
+			`(,loop (VECTOR-APPEND ,elements ,element))))
+		     (simple-backtracking-continuation elements))))
+	   (lambda (elements)
+	     (if-succeed pointer elements))))))))
 
 ;;; Edwin Variables:
 ;;; Eval: (scheme-indent-method 'handle-pending-backtracking 1)
diff --git a/v7/src/star-parser/shared.scm b/v7/src/star-parser/shared.scm
index aab682e4c..ab6818814 100644
--- a/v7/src/star-parser/shared.scm
+++ b/v7/src/star-parser/shared.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: shared.scm,v 1.6 2001/07/02 05:08:22 cph Exp $
+;;; $Id: shared.scm,v 1.7 2001/07/02 12:14:35 cph Exp $
 ;;;
 ;;; Copyright (c) 2001 Massachusetts Institute of Technology
 ;;;
@@ -90,61 +90,48 @@
 
 ;;;; Buffer pointers
 
-(define (no-pointers)
-  ;; Initial pointer set, used only when we know nothing about the
-  ;; context that an expression is expanding in.
-  (cons #f #f))
-
-(define (with-current-pointer pointers procedure)
-  ;; Get a pointer to the current position, if any.  This is called
-  ;; wherever we potentially need a pointer reference.  But we track
-  ;; usage of the pointer, so that we only generate calls to
-  ;; GET-PARSER-BUFFER-POINTER when the pointer is used.
-  (if (or (cdr pointers) (car pointers))
-      (procedure pointers)
-      (let ((v.u (cons (generate-uninterned-symbol) #f)))
-	(let ((x (procedure (cons v.u (cdr pointers)))))
-	  (if (cdr v.u)
-	      `(LET ((,(car v.u) (GET-PARSER-BUFFER-POINTER ,*buffer-name*)))
-		 ,x)
-	      x)))))
-
-(define (current-pointer pointers)
-  (let ((pointer
-	 (or (cdr pointers)
-	     (car pointers)
-	     (error "Missing required current pointer:" pointers))))
-    (set-cdr! pointer #t)
-    (car pointer)))
-
-(define (new-backtrack-pointer backtrack-pointers pointers)
+(define (call-with-unknown-pointer procedure)
+  (let ((v.u (cons (generate-uninterned-symbol) #f)))
+    (let ((x (procedure (cons v.u #f))))
+      (if (cdr v.u)
+	  `(LET ((,(car v.u) (GET-PARSER-BUFFER-POINTER ,*buffer-name*)))
+	     ,x)
+	  x))))
+
+(define (backtrack-to backtrack-pointer pointer)
   ;; Specify that we want to backtrack to the position specified in
-  ;; BACKTRACK-POINTERS.  But don't actually change the position yet.
+  ;; BACKTRACK-POINTER.  But don't actually change the position yet.
   ;; Instead delay the move until it's actually needed.  Without the
   ;; delay, we can generate multiple sequential calls to change the
   ;; position, which is wasteful since only the last call in the
   ;; sequence is meaningful.
-  (cons (car pointers)
-	(if (eq? (car pointers) (car backtrack-pointers))
-	    #f
-	    (car backtrack-pointers))))
+  (cons (car pointer)
+	(let ((p (or (cdr pointer) (car pointer))))
+	  (if (eq? (car pointer) (car backtrack-pointer))
+	      #f
+	      (car backtrack-pointer)))))
 
-(define (handle-pending-backtracking pointers procedure)
+(define (handle-pending-backtracking pointer procedure)
   ;; Perform a pending backtracking operation, if any.
-  (if (cdr pointers)
+  (if (cdr pointer)
       (begin
-	(set-cdr! (cdr pointers) #t)
+	(set-cdr! (cdr pointer) #t)
 	`(BEGIN
-	   (SET-PARSER-BUFFER-POINTER! ,*buffer-name* ,(car (cdr pointers)))
-	   ,(procedure (cons (cdr pointers) #f))))
-      (procedure (cons (car pointers) #f))))
+	   (SET-PARSER-BUFFER-POINTER! ,*buffer-name* ,(car (cdr pointer)))
+	   ,(procedure (cons (cdr pointer) #f))))
+      (procedure (cons (car pointer) #f))))
 
 (define (simple-backtracking-continuation value)
-  (lambda (pointers)
-    (handle-pending-backtracking pointers
-      (lambda (pointers)
-	pointers
+  (lambda (pointer)
+    (handle-pending-backtracking pointer
+      (lambda (pointer)
+	pointer
 	value))))
+
+(define (pointer-reference pointer)
+  (let ((p (or (cdr pointer) (car pointer))))
+    (set-cdr! p #t)
+    (car p)))
 
 ;;;; Code optimizer