[Chicken-hackers] [PATCH] Make `define-constant` support singly-quoted symbols

[Evan Hanson]

Allows the following program to work correctly:

  (define-constant a 'frizzle)
  (print a)

Previously, the second `a` would be replaced by an *unquoted* `frizzle`,
resulting in an undefined variable reference (or, if the constant value
were instead `(quote a)`, causing the compiler to enter an infinite
loop). This patch makes sure constant values are quoted after evaluation
so that collapsable literal constants (including symbols) are always
treated as data when substituted into their usage sites.
---
 core.scm | 25 ++++++++++++-------------
 1 file changed, 12 insertions(+), 13 deletions(-)

diff --git a/core.scm b/core.scm
index 9766c11..c22c6ce 100644
--- a/core.scm
+++ b/core.scm
@@ -1223,31 +1223,30 @@
                             '(##core#undefined)))
 
                        ((##core#define-constant)
-                        (let* ([name (second x)]
-                               [valexp (third x)]
-                               [val (handle-exceptions ex
+                        (let* ((name (second x))
+                               (expr (third x))
+                               (val (handle-exceptions ex
                                         ;; could show line number here
                                         (quit-compiling "error in constant 
evaluation of ~S for named constant `~S'"
-                                              valexp name)
-                                      (if (and (not (symbol? valexp))
-                                               (collapsable-literal? valexp))
-                                          valexp
-                                          (eval
-                                           `(##core#let
-                                             ,defconstant-bindings ,valexp)) ) 
) ] )
+                                                        expr name)
+                                     `(##core#quote
+                                       ,(if (and (not (symbol? expr))
+                                                 (collapsable-literal? expr))
+                                            expr
+                                            (eval `(##core#let 
,defconstant-bindings ,expr)))))))
                           (set! constants-used #t)
                           (set! defconstant-bindings
-                            (cons (list name `',val)  defconstant-bindings))
+                            (cons (list name val) defconstant-bindings))
                           (cond ((collapsable-literal? val)
                                  (##sys#hash-table-set! constant-table name 
(list val))
                                  '(##core#undefined) )
                                 ((basic-literal? val)
-                                 (let ([var (gensym "constant")])
+                                 (let ((var (gensym "constant")))
                                    (##sys#hash-table-set! constant-table name 
(list var))
                                    (hide-variable var)
                                    (mark-variable var '##compiler#constant)
                                    (mark-variable var '##compiler#always-bound)
-                                   (walk `(define ,var ',val) e se #f #f h ln) 
) )
+                                   (walk `(define ,var ,val) e se #f #f h ln)))
                                 (else
                                  (quit-compiling "invalid compile-time value 
for named constant `~S'"
                                        name)))))
-- 
2.8.1