From bcb6f2f5a940a0e0feb1eedeb66ac3ccc19c2e7a Mon Sep 17 00:00:00 2001
From: Peter Bex <address@hidden>
Date: Sun, 29 May 2016 15:54:29 +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 +++
 compiler.scm | 12 ++++++------
 2 files changed, 9 insertions(+), 6 deletions(-)

diff --git a/NEWS b/NEWS
index 462bf6b..2893626 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 80928f2..04206b9 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,15 +1155,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