Hi hackers,
As the commit message for the second patch says: now that all built-in
values are namespaced rather than marked as "##core#primitive" and
aliased with a "#%" prefix, we can drop all special handling for
primitive variable marks.
The first patch is necessary because I forgot to update the srfi-6
module's "vexports" list when we moved its procedures into chicken.base,
so it was still using primitive aliasing instead of namespaces.
I've left a couple of "this looks wrong" type comments in place without
further investigation. Sorry, another day perhaps.
Cheers,
Evan
>From 98dcd2b4f9f08edd7e8c132deab705ce052b0815 Mon Sep 17 00:00:00 2001
From: Evan Hanson <ev...@foldling.org>
Date: Wed, 14 Mar 2018 18:53:33 +1300
Subject: [PATCH 1/2] Properly namespace srfi-6 module value exports
Because they were not pairs, the items in the srfi-6 module's value
exports list were being marked with "##sys#primitive-alias" rather than
rewritten to their namespaced counterparts.
This patch makes the srfi-6 module's exports list a map of namespaced
values as should have been done in 6d1262c1.
---
modules.scm | 5 ++++-
1 file changed, 4 insertions(+), 1 deletion(-)
diff --git a/modules.scm b/modules.scm
index 26cd8d46..aed031c4 100644
--- a/modules.scm
+++ b/modules.scm
@@ -1065,7 +1065,10 @@
'srfi-2 '() (se-subset '(and-let*) ##sys#chicken.base-macro-environment))
(##sys#register-core-module
- 'srfi-6 'library '(open-input-string open-output-string get-output-string))
+ 'srfi-6 'library
+ '((get-output-string . chicken.base#get-output-string)
+ (open-input-string . chicken.base#open-input-string)
+ (open-output-string . chicken.base#open-input-string)))
(##sys#register-primitive-module
'srfi-8 '() (se-subset '(receive) ##sys#chicken.base-macro-environment))
--
2.11.0
>From 568d5a773f0c86af76a0e1953e3b401c0417149d Mon Sep 17 00:00:00 2001
From: Evan Hanson <ev...@foldling.org>
Date: Wed, 14 Mar 2018 18:53:48 +1300
Subject: [PATCH 2/2] Remove primitive aliasing
Now that all built-in values are namespaced rather than marked as
"##core#primitive" and aliased with a "#%" prefix, we can drop all
special handling for primitive variable marks.
---
chicken-syntax.scm | 3 +--
compiler-syntax.scm | 8 ++++----
core.scm | 7 ++-----
eval.scm | 16 ++++++++--------
expand.scm | 10 +---------
modules.scm | 17 ++++-------------
6 files changed, 20 insertions(+), 41 deletions(-)
diff --git a/chicken-syntax.scm b/chicken-syntax.scm
index c267f198..772c59d9 100644
--- a/chicken-syntax.scm
+++ b/chicken-syntax.scm
@@ -75,8 +75,7 @@
(##sys#extend-macro-environment
'condition-case
- `((else . ,(##sys#primitive-alias 'else))
- (memv . scheme#memv))
+ `((memv . scheme#memv))
(##sys#er-transformer
(lambda (form r c)
(##sys#check-syntax 'condition-case form '(_ _ . _))
diff --git a/compiler-syntax.scm b/compiler-syntax.scm
index 57ca9fbb..ca73b5ac 100644
--- a/compiler-syntax.scm
+++ b/compiler-syntax.scm
@@ -67,7 +67,7 @@
((_ (names . llist) se . body)
(r-c-s 'names (lambda llist . body) se))))
-(define-internal-compiler-syntax ((scheme#for-each ##sys#for-each #%for-each) x r c)
+(define-internal-compiler-syntax ((scheme#for-each ##sys#for-each) x r c)
'((pair? . scheme#pair?))
(let ((%let (r 'let))
(%if (r 'if))
@@ -97,7 +97,7 @@
,@(map (lambda (v) `(##sys#slot ,v 1)) vars) ) )))))
x)))
-(define-internal-compiler-syntax ((scheme#map ##sys#map #%map) x r c)
+(define-internal-compiler-syntax ((scheme#map ##sys#map) x r c)
'((pair? . scheme#pair?) (cons . scheme#cons))
(let ((%let (r 'let))
(%if (r 'if))
@@ -274,7 +274,7 @@
(loop '()) )
(loop (cons c chunk)))))))))))))
-(define-internal-compiler-syntax ((chicken.base#foldr #%foldr) x r c)
+(define-internal-compiler-syntax ((chicken.base#foldr) x r c)
'((pair? . scheme#pair?))
(if (and (fx= (length x) 4)
(memq 'chicken.base#foldr extended-bindings) ) ; s.a.
@@ -296,7 +296,7 @@
,z))))
x))
-(define-internal-compiler-syntax ((chicken.base#foldl #%foldl) x r c)
+(define-internal-compiler-syntax ((chicken.base#foldl) x r c)
'((pair? . scheme#pair?))
(if (and (fx= (length x) 4)
(memq 'chicken.base#foldl extended-bindings) ) ; s.a.
diff --git a/core.scm b/core.scm
index 69822b98..be629780 100644
--- a/core.scm
+++ b/core.scm
@@ -578,7 +578,6 @@
(finish-foreign-result ft body)
t)
e se dest ldest h #f #f))))
- ((##sys#get x '##core#primitive))
((not (memq x e)) (##sys#alias-global-hook x #f h)) ; only if global
(else x))))
@@ -624,8 +623,7 @@
(##sys#syntax-error/context (sprintf "(~a) - malformed expression" ln) x)
(##sys#syntax-error/context "malformed expression" x)))
(set! ##sys#syntax-error-culprit x)
- (let* ((name0 (lookup (car x) se))
- (name (or (and (symbol? name0) (##sys#get name0 '##core#primitive)) name0))
+ (let* ((name (lookup (car x) se))
(xexpanded
(fluid-let ((chicken.syntax#expansion-result-hook
(handle-expansion-result ln)))
@@ -1100,8 +1098,7 @@
e se #f #f h ln #f))))
(else
(unless (memq var e) ; global?
- (set! var (or (##sys#get var '##core#primitive)
- (##sys#alias-global-hook var #t dest)))
+ (set! var (##sys#alias-global-hook var #t dest))
(when safe-globals-flag
(mark-variable var '##compiler#always-bound-to-procedure)
(mark-variable var '##compiler#always-bound))
diff --git a/eval.scm b/eval.scm
index 8dfbee9d..b777c412 100644
--- a/eval.scm
+++ b/eval.scm
@@ -134,10 +134,10 @@
(receive (i j) (lookup x e se)
(cond ((not i)
(let ((var (cond ((not (symbol? j)) x) ; syntax?
- ((not (assq x se))
- (and (not static)
- (##sys#alias-global-hook j #f cntr)))
- (else (or (##sys#get j '##core#primitive) j)))))
+ ((assq x se) j)
+ ((not static)
+ (##sys#alias-global-hook j #f cntr))
+ (else #f))))
(when (and ##sys#unbound-in-eval
(or (not var)
(not (##sys#symbol-has-toplevel-binding? var))))
@@ -263,10 +263,10 @@
((symbol? (cdr a))))
(##sys#notice "assignment to imported value binding" var)))
(let ((var
- (if (not (assq x se)) ;XXX this looks wrong
- (and (not static)
- (##sys#alias-global-hook j #t cntr))
- (or (##sys#get j '##core#primitive) j))))
+ (cond ((assq x se) j) ;XXX this looks wrong
+ ((not static)
+ (##sys#alias-global-hook j #t cntr))
+ (else #f))))
(if (not var) ; static
(lambda (v)
(##sys#error 'eval "environment is not mutable" evalenv var)) ;XXX var?
diff --git a/expand.scm b/expand.scm
index c33b547e..18237e54 100644
--- a/expand.scm
+++ b/expand.scm
@@ -91,12 +91,6 @@
;;XXX should this be in eval.scm?
(define ##sys#active-eval-environment (make-parameter ##sys#current-environment))
-(define (##sys#primitive-alias sym)
- (let ((alias (##sys#string->symbol
- (##sys#string-append "#%" (##sys#slot sym 1)))))
- (putp alias '##core#primitive sym)
- alias))
-
(define (lookup id se)
(cond ((##core#inline "C_u_i_assq" id se) => cdr)
((getp id '##core#macro-alias))
@@ -874,9 +868,7 @@
(lookup2 2 s2 dse)
s2) ) )
(cond ((symbol? ss1)
- (cond ((symbol? ss2)
- (eq? (or (getp ss1 '##core#primitive) ss1)
- (or (getp ss2 '##core#primitive) ss2)))
+ (cond ((symbol? ss2) (eq? ss1 ss2))
((assq ss1 (##sys#macro-environment)) =>
(lambda (a) (eq? (cdr a) ss2)))
(else #f) ) )
diff --git a/modules.scm b/modules.scm
index aed031c4..1a88dc92 100644
--- a/modules.scm
+++ b/modules.scm
@@ -407,11 +407,7 @@
(let* ((me (##sys#macro-environment))
(mod (make-module
name lib '()
- (map (lambda (ve)
- (if (symbol? ve)
- (cons ve (##sys#primitive-alias ve))
- ve))
- vexports)
+ vexports
(map (lambda (se)
(if (symbol? se)
(or (assq se me)
@@ -782,11 +778,7 @@
(module-rename sym (module-name mod))))
(else sym)))
(cond ((##sys#qualified-symbol? sym) sym)
- ((getp sym '##core#primitive) =>
- (lambda (p)
- (dm "(ALIAS) primitive: " p)
- p))
- ((getp sym '##core#aliased)
+ ((getp sym '##core#aliased)
(dm "(ALIAS) marked: " sym)
sym)
((namespaced-symbol? sym) sym)
@@ -794,9 +786,8 @@
(lambda (a)
(let ((sym2 (cdr a)))
(dm "(ALIAS) in current environment " sym " -> " sym2)
- (if (pair? sym2) ; macro (XXX can this be?)
- (mrename sym)
- (or (getp sym2 '##core#primitive) sym2)))))
+ ;; check for macro (XXX can this be?)
+ (if (pair? sym2) (mrename sym) sym2))))
(else (mrename sym))))
(define (##sys#validate-exports exps loc)
--
2.11.0
_______________________________________________
Chicken-hackers mailing list
Chicken-hackers@nongnu.org
https://lists.nongnu.org/mailman/listinfo/chicken-hackers
