~ chicken-core (chicken-5) 471cbbc6b6feb5b551defe3b3172c6ef0e2b2cd1

commit 471cbbc6b6feb5b551defe3b3172c6ef0e2b2cd1
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Sun May 29 15:54:29 2016 +0200
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Mon May 30 09:07:43 2016 +1200

    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 462bf6bf..28936260 100644
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,8 @@
 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/compiler.scm b/compiler.scm
index 80928f25..26486c57 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -1144,9 +1144,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 "error in constant evaluation of ~S for named constant `~S'" 
 					       valexp name)
@@ -1155,20 +1155,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 "invalid compile-time value for named constant `~S'"
 					name)))))