~ chicken-core (chicken-5) d910cef6f84554fb4738112ddb46fa2aaf70faa1

commit d910cef6f84554fb4738112ddb46fa2aaf70faa1
Author:     Evan Hanson <evhan@foldling.org>
AuthorDate: Sun May 29 15:54:58 2016 +0200
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Sun May 29 15:54:58 2016 +0200

    Make `define-constant` support singly-quoted symbols
    
    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.
    
    Signed-off-by: Evan Hanson <evhan@foldling.org>

diff --git a/NEWS b/NEWS
index 3d0b0b54..7214e7d9 100644
--- a/NEWS
+++ b/NEWS
@@ -39,6 +39,9 @@
 
 4.11.1
 
+- Compiler:
+  - define-constant now correctly keeps symbol values quoted.
+
 - Runtime system:
   - C_locative_ref has been deprecated in favor of C_a_i_locative_ref,
     which is faster because it is inlined (#1260, thanks to Kooda).
diff --git a/core.scm b/core.scm
index 9766c113..8d993a5c 100644
--- a/core.scm
+++ b/core.scm
@@ -1223,9 +1223,9 @@
 			     '(##core#undefined)))
 
 			((##core#define-constant)
-			 (let* ([name (second x)]
-				[valexp (third x)]
-				[val (handle-exceptions ex
+			 (let* ((name (second x))
+				(valexp (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)
@@ -1234,20 +1234,20 @@
 					   valexp
 					   (eval
 					    `(##core#let
-					      ,defconstant-bindings ,valexp)) ) ) ] )
+					      ,defconstant-bindings ,valexp))))))
 			   (set! constants-used #t)
 			   (set! defconstant-bindings
-			     (cons (list name `',val)  defconstant-bindings))
+			     (cons (list name `(##core#quote ,val)) defconstant-bindings))
 			   (cond ((collapsable-literal? val)
-				  (##sys#hash-table-set! constant-table name (list val))
-				  '(##core#undefined) )
+				  (##sys#hash-table-set! constant-table name (list `(##core#quote ,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 (##core#quote ,val)) e se #f #f h ln)))
 				 (else
 				  (quit-compiling "invalid compile-time value for named constant `~S'"
 					name)))))