From 1a9f3d60be0e9068bfa587696f7c1a379fd2bcaf Mon Sep 17 00:00:00 2001
From: Peter Bex <address@hidden>
Date: Sun, 29 May 2016 15:54:58 +0200
Subject: [PATCH] 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.
---
 NEWS     |  3 +++
 core.scm | 12 ++++++------
 2 files changed, 9 insertions(+), 6 deletions(-)

diff --git a/NEWS b/NEWS
index 3d0b0b5..7214e7d 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 9766c11..00bd938 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,15 +1234,15 @@
 					   valexp
 					   (eval
 					    `(##core#let
-					      ,defconstant-bindings ,valexp)) ) ) ] )
+					      ,defconstant-bindings ,valexp)) ) ) ) )
 			   (set! constants-used #t)
 			   (set! defconstant-bindings
 			     (cons (list name `',val)  defconstant-bindings))
 			   (cond ((collapsable-literal? val)
-				  (##sys#hash-table-set! constant-table name (list 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)
-- 
2.1.4