Thanks - forget about this one.
I've successfully thrown together two (attached) files containing a
compilation unit each, which contain modules for srfi-34&35. Those
replaced the module-unaware define-macro versions I used before.
Works!!!
BUT 1st (minor) Question: it appears that I'm unable to find the
correct csc invocation to compile those files as units. I tried -t
<filename-without-extension> -u <filename-without-extension> but
eventually resorted to insert a (declare (unit srfi-XX)) at the begin of
the files.
BTW: Thanks Felix for the correct pointer into svn. The matchable case
has been resolved by the current version. (But somehow the same thing,
to compile it, I had to insert that (declare (unit matchable)) at the
begin.
Sorry for my momentary reluctance to convert my build process to use
eggs etc. straight from svn or some chicken aware environment. This
ground is shaky enough at the moment and I'm pretty late with my port to
chicken "3". Or became it 4 now? So I better change one thing at a
time.
2nd (real) Question: [Background: My program implements sort of a
Scheme interpreter, mostly passing though the compiled primitives from
the underlying Scheme system (so right now rscheme and chicken).] Upon
initialisation I used to pass the bindings from a list of symbols like
this:
(for-each
(lambda (binding-name)
(export-to-my-own-envt (eval binding-name) binding-name))
'(<list of r5rs and some more top level variables>))
As said: this used to work and works for all the top level bindings
except those two I moved into the srfi-35 module!
Now the no-option is to write:
(for-each
(lambda (binding-name)
(export-to-my-own-envt (eval `(begin (import srfi-35) ,binding-name))
binding-name))
'(<list of r5rs and some more top level variables>))
Or some such. Since that would evaluate the import statement (and soon
to be multiple statements) so many times upon startup for no value.
Man, I was already contemplating to use cryopid or something to
freeze&restart the chicken built process after initialisation (similar
to rscheme's, LaTeX's or emacs's dumped heap feature). No, please to
not make me "import" at runtime. Not at all - because I noticed that
this will try to load those dynamic import libraries. A) Eventually I
want to be able to link the whole thing statically or at least be
absolutely sure it will not load any *single* file I did not know
before. B) Startup time.
So: I know the process did the import work before. If I compile
(export-to-my-own-envt binding-name 'binding-name)
everything works as I want it. The question remains: what do I do with
my list, where bindings come from several modules?
a) I could expand it at compile time into the unrolled for-each loop.
That's quite a lot of code to be executed just once, isn't it? (Not the
typing, that's a macro's one time work. The run time code is my concern
here; maybe it's not that much of a damage - that's what I don't know.)
b) Use whatever means to pass all the top level bindings named by list
of symbols from the ???current???, "compile time" environment (where
it's obviously bound already) -- and not the one "eval" sees (where it's
unbound and would require yet another import) -- into my
export-to-my-own-envt procedure (which currently happens to be a
hash-table-set! with intentionally reversed arguments to better catch
accidental misuse; but that might change any time).
* I can do (a), but I'm afraid that's stupid. Is it?
* If (b) is better (or simply easier, since (a) is to be some rewrite
work in several files), how could I do it?
Thanks a lot
/Jörg
PS: If the attached code is useful, take it under the standard chicken
BSD licence or GPL or public domain at your discretion (and let me know
if this would be in conflict with the underlying reference
implementations - I really did not to anything but wrap them into a
module clause and find the right import trick to rebind a global
identifier -- plus this ugly "declare" statement I'd like you to help me
get rid of anyway).
Am Donnerstag, den 09.10.2008, 17:46 +0200 schrieb Jörg F. Wittenberger:
> Am Donnerstag, den 09.10.2008, 12:07 +0200 schrieb felix winkelmann:
> > On Wed, Oct 8, 2008 at 12:45 PM, Jörg F. Wittenberger
> > <[EMAIL PROTECTED]> wrote:
> > >
> > > Yesterday I tried to convert my code to the module system. But
> that
> > > failed. For the time being I managed to get along without
> modules.
> > >
> > > I've got the impression - though this is probably wrong - that I
> can
> > > either convert everything into modules or nothing at all.
> >
> > You don't have to. But if you use extensions that provide modules,
> you'll
> > have to add the proper "import" forms.
>
> This appears to be my problem.
(declare (unit srfi-34))
(module
srfi-34 *
(import scheme srfi-18)
(define-syntax guard
(syntax-rules ()
((guard (var clause ...) e1 e2 ...)
((call-with-current-continuation
(lambda (guard-k)
(with-exception-handler
(lambda (condition)
((call-with-current-continuation
(lambda (handler-k)
(guard-k
(lambda ()
(let ((var condition)) ; clauses may SET! var
(guard-aux (handler-k (lambda ()
(raise condition)))
clause ...))))))))
(lambda ()
(call-with-values
(lambda () e1 e2 ...)
(lambda args
(guard-k (lambda ()
(apply values args)))))))))))))
(define-syntax guard-aux
(syntax-rules (else =>)
((guard-aux reraise (else result1 result2 ...))
(begin result1 result2 ...))
((guard-aux reraise (test => result))
(let ((temp test))
(if temp
(result temp)
reraise)))
((guard-aux reraise (test => result) clause1 clause2 ...)
(let ((temp test))
(if temp
(result temp)
(guard-aux reraise clause1 clause2 ...))))
((guard-aux reraise (test))
test)
((guard-aux reraise (test) clause1 clause2 ...)
(let ((temp test))
(if temp
temp
(guard-aux reraise clause1 clause2 ...))))
((guard-aux reraise (test result1 result2 ...))
(if test
(begin result1 result2 ...)
reraise))
((guard-aux reraise (test result1 result2 ...) clause1 clause2 ...)
(if test
(begin result1 result2 ...)
(guard-aux reraise clause1 clause2 ...)))))
)
(declare (unit srfi-35)
(uses util)
)
(module
;; SRFI 35 reference implementation, dancing around a name clash with
;; chicken3. TODO remove the dance, that's what the module system is
;; supposed be to good for. Also clean up the export list!
srfi-35 *
(import scheme
(except chicken condition?)
(rename chicken (condition? orig.condition?))
srfi-1)
(define-record-type :condition-type
(really-make-condition-type name supertype fields all-fields)
condition-type?
(name condition-type-name)
(supertype condition-type-supertype)
(fields condition-type-fields)
(all-fields condition-type-all-fields))
(define (make-condition-type name supertype fields)
(if (not (symbol? name))
(error "make-condition-type: name is not a symbol"
name))
(if (not (condition-type? supertype))
(error "make-condition-type: supertype is not a condition type"
supertype))
(if (not
(null? (lset-intersection eq?
(condition-type-all-fields supertype)
fields)))
(error "duplicate field name" ))
(really-make-condition-type name
supertype
fields
(append (condition-type-all-fields supertype)
fields)))
(define-syntax define-condition-type
(syntax-rules ()
((define-condition-type ?name ?supertype ?predicate
(?field1 ?accessor1) ...)
(begin
(define ?name
(make-condition-type '?name
?supertype
'(?field1 ...)))
(define (?predicate thing)
(and (condition? thing)
(condition-has-type? thing ?name)))
(define (?accessor1 condition)
(condition-ref (extract-condition condition ?name)
'?field1))
...))))
(define (condition-subtype? subtype supertype)
(let recur ((subtype subtype))
(cond ((not subtype) #f)
((eq? subtype supertype) #t)
(else
(recur (condition-type-supertype subtype))))))
(define (condition-type-field-supertype condition-type field)
(let loop ((condition-type condition-type))
(cond ((not condition-type) #f)
((memq field (condition-type-fields condition-type))
condition-type)
(else
(loop (condition-type-supertype condition-type))))))
;; The type-field-alist is of the form
;; ((<type> (<field-name> . <value>) ...) ...)
(define-record-type :condition
(really-make-condition type-field-alist)
condition?*
(type-field-alist condition-type-field-alist))
(define chicken-condition? orig.condition?)
(define (condition? obj)
(or (condition?* obj) (chicken-condition? obj)))
(define (make-condition type . field-plist)
(let ((alist (let label ((plist field-plist))
(if (null? plist)
'()
(cons (cons (car plist)
(cadr plist))
(label (cddr plist)))))))
(if (not (lset= eq?
(condition-type-all-fields type)
(map car alist)))
(error "condition fields don't match condition type"))
(really-make-condition (list (cons type alist)))))
(define (condition-has-type? condition type)
(and (condition?* condition)
(any (lambda (has-type)
(condition-subtype? has-type type))
(condition-types condition))))
(define (condition-ref condition field)
(type-field-alist-ref (condition-type-field-alist condition)
field))
(define (type-field-alist-ref type-field-alist field)
(let loop ((type-field-alist type-field-alist))
(cond ((null? type-field-alist)
(error "type-field-alist-ref: field not found"
type-field-alist field))
((assq field (cdr (car type-field-alist)))
=> cdr)
(else
(loop (cdr type-field-alist))))))
(define (make-compound-condition condition-1 . conditions)
(really-make-condition
(apply append (map condition-type-field-alist
(cons condition-1 conditions)))))
(define (extract-condition condition type)
(let ((entry (find (lambda (entry)
(condition-subtype? (car entry) type))
(condition-type-field-alist condition))))
(if (not entry)
(error "extract-condition: invalid condition type"
condition type))
(really-make-condition
(list (cons type
(map (lambda (field)
(assq field (cdr entry)))
(condition-type-all-fields type)))))))
(define-syntax condition
(syntax-rules ()
((condition (?type1 (?field1 ?value1) ...) ...)
(type-field-alist->condition
(list
(cons ?type1
(list (cons '?field1 ?value1) ...))
...)))))
(define (type-field-alist->condition type-field-alist)
(really-make-condition
(map (lambda (entry)
(cons (car entry)
(map (lambda (field)
(or (assq field (cdr entry))
(cons field
(type-field-alist-ref type-field-alist field))))
(condition-type-all-fields (car entry)))))
type-field-alist)))
(define (condition-types condition)
(if (condition?* condition)
(map car (condition-type-field-alist condition))
'()))
(define (check-condition-type-field-alist the-type-field-alist)
(let loop ((type-field-alist the-type-field-alist))
(if (not (null? type-field-alist))
(let* ((entry (car type-field-alist))
(type (car entry))
(field-alist (cdr entry))
(fields (map car field-alist))
(all-fields (condition-type-all-fields type)))
(for-each (lambda (missing-field)
(let ((supertype
(condition-type-field-supertype type missing-field)))
(if (not
(any (lambda (entry)
(let ((type (car entry)))
(condition-subtype? type supertype)))
the-type-field-alist))
(error "missing field in condition construction"
type
missing-field))))
(lset-difference eq? all-fields fields))
(loop (cdr type-field-alist))))))
(define &condition (really-make-condition-type '&condition
#f
'()
'()))
(define-condition-type &message &condition
message-condition?
(message condition-message))
(define-condition-type &serious &condition serious-condition?)
(define-condition-type &error &serious error?)
)
(import (rename srfi-35 (condition? srfi35:condtition?)))
(set! condition? srfi35:condtition?)
_______________________________________________
Chicken-users mailing list
[email protected]
http://lists.nongnu.org/mailman/listinfo/chicken-users
