~ chicken-core (chicken-5) 021384ba3a9d273dd1f7d95e386c412cdc7489e3

commit 021384ba3a9d273dd1f7d95e386c412cdc7489e3
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Mon May 23 13:37:48 2011 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Mon May 23 13:37:48 2011 +0200

    stricter error check for value part of constant definitions (problem reported by Kon Lovett)

diff --git a/compiler.scm b/compiler.scm
index d501ed8f..a3fa6209 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -1104,7 +1104,7 @@
 				[valexp (third x)]
 				[val (handle-exceptions ex
 					 ;; could show line number here
-					 (quit "error in constant evaluation of ~S for named constant ~S" 
+					 (quit "error in constant evaluation of ~S for named constant `~S'" 
 					       valexp name)
 				       (if (and (not (symbol? valexp))
 						(collapsable-literal? valexp))
@@ -1113,17 +1113,21 @@
 					    `(##core#let
 					      ,defconstant-bindings ,valexp)) ) ) ] )
 			   (set! constants-used #t)
-			   (set! defconstant-bindings (cons (list name `',val) defconstant-bindings))
-			   (cond [(collapsable-literal? val)
+			   (set! defconstant-bindings
+			     (cons (list name `',val)  defconstant-bindings))
+			   (cond ((collapsable-literal? val)
 				  (##sys#hash-table-set! constant-table name (list val))
-				  '(##core#undefined) ]
-				 [else
+				  '(##core#undefined) )
+				 ((basic-literal? val)
 				  (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) ) ] ) ) )
+				    (walk `(define ,var ',val) e se #f #f h) ) )
+				 (else
+				  (quit "invalid compile-time value for named constant `~S'"
+					name)))))
 
 			((##core#declare)
 			 (walk