"Pascal Bourguignon" <····@mouse-potato.com> a �crit dans le message de
···················@thalassa.informatimago.com...
> "Christophe Turle" <······@nospam.com> writes:
> > Yes, i'm currently trying to wrap all exported symbols from CL in their
> > downcase counterpart.
>
> You could start like this:
>
> (defpackage "common-lisp" (:nicknames "cl") (:use))
> (do-external-symbols (s "COMMON-LISP")
> (let ((scs (intern (string-downcase (symbol-name s)) "common-lisp")))
> (define-symbol-macro scs s)
> (when (fboundp s)
> (setf (symbol-function scs) (symbol-function s)))
> (setf (symbol-plist scs) (symbol-plist s))
> (export scs "common-lisp")))
> (defpackage "common-lisp-user" (:nicknames "cl-user") (:use
"common-lisp"))
> (in-package "common-lisp-user")
> (|defun| |fun| (|a| |b|) (+ |a| |b|))
> (|fun| 5550000 690)
>
> (this won't work as is, I've got some problems with special operators
> or macros it seems).
We have very similar versions !
(defpackage "common-lisp" (:nicknames "cl") (:use))
(defun def-wrapper (new old)
;;(when (boundp ,old-var) (set ,new-var (symbol-value ,old-var)))
;; not sufficient must check for a symbol-macro ...
(when (fboundp old)
(if (or (macro-function old) (special-form-p old))
(def-macro/special-form-wrapper new old)
(def-function-wrapper new old) )))
(defun def-macro/special-form-wrapper (new old)
(eval `(defmacro ,new (&rest args)
`(,',old ,@args) )))
(defun def-function-wrapper (new old)
(eval `(defun ,new (&rest args)
(apply #',old args) )))
(do-external-symbols (old (find-package "CL"))
(let ((new (intern (string-downcase (symbol-name old)) "cl")))
(def-wrapper new old)
(export new "cl") ))
(defpackage "common-lisp-user" (:nicknames "user") (:use "cl"))
(in-package "user")
;; or |*readtable*| ...
(|defvar| *readtable* (|copy-readtable| cl:nil))
;; doesn't work yet. the setf must be handled differently. Tomorrow ...
(|setf| (|readtable-case| *readtable*) :preserve)
> But as you can see, that does not avoid the need to change the
> readtable-case!!!
>
> And once you set the readtable-case as you want, you don't have to
> rename the symbols.
>
yes for sure i have to use readtable-case :preserve
Thx.
___________________________________________________________
Christophe Turle.
(format nil ···@~S.~S" 'c.turle 'wanadoo 'fr)
sava preview : http://perso.wanadoo.fr/turle/lisp/sava.html
"Christophe Turle" <······@nospam.com> a �crit dans le message de
····························@news.free.fr...
> "Pascal Bourguignon" <····@mouse-potato.com> a �crit dans le message de
> ···················@thalassa.informatimago.com...
> > "Christophe Turle" <······@nospam.com> writes:
> > > Yes, i'm currently trying to wrap all exported symbols from CL in
their
> > > downcase counterpart.
> >
> > You could start like this:
> >
> > (defpackage "common-lisp" (:nicknames "cl") (:use))
> > (do-external-symbols (s "COMMON-LISP")
> > (let ((scs (intern (string-downcase (symbol-name s)) "common-lisp")))
> > (define-symbol-macro scs s)
> > (when (fboundp s)
> > (setf (symbol-function scs) (symbol-function s)))
> > (setf (symbol-plist scs) (symbol-plist s))
> > (export scs "common-lisp")))
> > (defpackage "common-lisp-user" (:nicknames "cl-user") (:use
> "common-lisp"))
> > (in-package "common-lisp-user")
> > (|defun| |fun| (|a| |b|) (+ |a| |b|))
> > (|fun| 5550000 690)
> >
> > (this won't work as is, I've got some problems with special operators
> > or macros it seems).
>
> We have very similar versions !
>
> (defpackage "common-lisp" (:nicknames "cl") (:use))
>
> (defun def-wrapper (new old)
> ;;(when (boundp ,old-var) (set ,new-var (symbol-value ,old-var)))
> ;; not sufficient must check for a symbol-macro ...
;; to handle the setf case and surely others :
(setf (symbol-plist new) (symbol-plist old))
> (when (fboundp old)
> (if (or (macro-function old) (special-form-p old))
> (def-macro/special-form-wrapper new old)
> (def-function-wrapper new old) )))
>
> (defun def-macro/special-form-wrapper (new old)
> (eval `(defmacro ,new (&rest args)
> `(,',old ,@args) )))
>
> (defun def-function-wrapper (new old)
> (eval `(defun ,new (&rest args)
> (apply #',old args) )))
>
> (do-external-symbols (old (find-package "CL"))
> (let ((new (intern (string-downcase (symbol-name old)) "cl")))
> (def-wrapper new old)
> (export new "cl") ))
>
> (defpackage "common-lisp-user" (:nicknames "user") (:use "cl"))
>
> (in-package "user")
>
> ;; or |*readtable*| ...
> (|defvar| *readtable* (|copy-readtable| cl:nil))
>
> ;; doesn't work yet. the setf must be handled differently. Tomorrow ...
> (|setf| (|readtable-case| *readtable*) :preserve)
replaced by :
;; just for testing since it changes the overall reader behavior.
(|setf| (|readtable-case| cl:*readtable*) :preserve)
USER[44]> (defun fun (a b) (+ a b))
fun
USER[48]> (fun 5550000 690)
5550690
USER[49]> (fun 5550000 (1+ 690))
5550691
Ok, this seems fine but in fact we will bump into the wall with
symbol-value.
USER[65]> CL:*PACKAGE*
#<PACKAGE common-lisp-user>
USER[66]> cl:*package*
#<PACKAGE COMMON-LISP-USER>
Damned ! here we can see what i was meaning when writing that symbols denote
more concepts than names. There's really a 'CL:*PACKAGE*' concept. It is not
the name of '#<PACKAGE common-lisp-user>'.
A new solution seems to be the implementation of (name 1-* -> 0-1 symbol)
Hacking 'find-symbol' or 'intern' seems to be a good start, if only 'read'
use them. If it's not the case directly hacking read should work.
___________________________________________________________
Christophe Turle.
(format nil ···@~S.~S" 'c.turle 'wanadoo 'fr)
sava preview : http://perso.wanadoo.fr/turle/lisp/sava.html
"Pascal Bourguignon" <····@mouse-potato.com> a �crit dans le message de
···················@thalassa.informatimago.com...
> "Christophe Turle" <······@nospam.com> writes:
> > USER[65]> CL:*PACKAGE*
> > #<PACKAGE common-lisp-user>
> >
> > USER[66]> cl:*package*
> > #<PACKAGE COMMON-LISP-USER>
> >
> > Damned ! here we can see what i was meaning when writing that symbols
denote
> > more concepts than names. There's really a 'CL:*PACKAGE*' concept. It is
not
> > the name of '#<PACKAGE common-lisp-user>'.
>
> You need to use symbol-macros for all boundp symbols.
>
> (define-symbol-macro new old)
>
Yes ! i was wondering why such a macro was not existing. Next time i will
try to look into hyperspec instead of cltl2 ;)
___________________________________________________________
Christophe Turle.
(format nil ···@~S.~S" 'c.turle 'wanadoo 'fr)
sava preview : http://perso.wanadoo.fr/turle/lisp/sava.html