From kend@newton.apple.com Tue Mar 29 19:55:37 EST 1994 Article: 8471 of comp.lang.scheme Xref: glinda.oz.cs.cmu.edu comp.lang.scheme:8471 Path: honeydew.srv.cs.cmu.edu!fs7.ece.cmu.edu!europa.eng.gtefsd.com!library.ucla.edu!agate!apple.com!dickey-kenneth2.apple.com!kend From: Ken Dickey Newsgroups: comp.lang.scheme Subject: Re: Are packages lexical environments? Date: 28 Mar 1994 17:34:49 GMT Organization: Bauhaus Lines: 419 Distribution: world Message-ID: <2n74fp$pco@apple.com> References: <2mkloi$9c@nef.ens.fr> NNTP-Posting-Host: 17.201.48.15 X-UserAgent: Nuntius v1.1.1d11 X-XXMessage-ID: X-XXDate: Mon, 28 Mar 94 17:34:15 GMT Subject: Are packages lexical environments? From: Juliusz Chroboczek, jch@fregate.ens.fr Date: 21 Mar 1994 17:33:06 GMT In article <2mkloi$9c@nef.ens.fr> Juliusz Chroboczek, jch@fregate.ens.fr writes: > Thinking about the problems of modules for Scheme, I have found out >that I do not see any fundamental difference between packages and >lexical environments. ... Well, if you are talking about CL packages, there is a big difference in symbol usage. I.e. you can have symbols which have the same print name but are not eq, being in different (or no) packages. Having done some CL work lately, I finally see why I have heard people bashing them for years. What is really desired in modules is not just namespace management, but the ability to separately compile code and then link it together, taking advantage of early binding information. (IMHO) One of the hard problems is dealing appropriately with macros. You might want to take a look at: Curtus & Rauen: "A Module System for Scheme", Proc 1990 ACM Conference on Lisp and Functional Programming for a discussion of some of the issues. Following is a simple namespace management implementation using lexical environments and (by way of example) Jaffer's debug routines. Note that under this scheme (8^) you can reload the debug file as often as you like with no name redefinition problems creaping in. ; FILE "Units" ; IMPLEMENTS Import/export units. A "unit" can be thought of ; as a light-weight module/namespace. Aside from the global ; namespace, units import from other units. Anyone can import ; explicity via unit-lookup, e.g. ; (define foo (unit-lookup baz-unit 'bar)) . ; AUTHOR Ken Dickey ; DATE 1993 September 24 ; LAST UPDATE 1993 September 24 ; REQUIRES: R4RS Macros ; INTERFACE ; (define-unit ; (import ( ...) ...) ; ... ; (export ...)) -> creates namespace ; ; Where the IMPORT clause and can be empty. ; (unit-lookup ') will return the value of in or #f. ; Note that units are evaluated in order, i.e. there is no attempt here to ; be able to export macros or define mutually referential units. ; IMPLEMENTATION -- association lists. Imports expand to an enclosing LET ; form. (define (UNIT-LOOKUP ) (cond ((assq ) => cdr) (else #f)) ) (define-syntax EXPORT (syntax-rules '() ((export ...) ; => (list (cons ' ) ...) ) ) ) (define-syntax DEFINE-UNIT (syntax-rules '(imports %helper%) ((define-unit (imports ...) ...) ; => (define-unit %helper% ( ...) () ( ...)) ) ((define-unit %helper% () ( ...)) ; => (define (let ...)) ) ((define-unit %helper% (( ...) ...) ( ...) ) ; => (define-unit %helper% ( ...) (( (unit-lookup ')) ... ...) ) ) ) ) ;; --- E O F Units --- ;; ================debug.scm================= ;;;; Utility functions for debugging in Scheme. ;;; Copyright (C) 1991, 1992, 1993 Aubrey Jaffer. ;Permission to copy this software, to redistribute it, and to use it ;for any purpose is granted, subject to the following restrictions and ;understandings. ;1. Any copy made of this software must include this copyright notice ;in full. ;2. I have made no warrantee or representation that the operation of ;this software will be error-free, and I am under no obligation to ;provide any services, by way of maintenance, update, or otherwise. ;3. In conjunction with products arising from the use of this ;material, there shall be no use of my name in any advertising, ;promotional, or sales literature without prior written consent in ;each case. (require 'unit) (define-unit DEBUG-UNIT (IMPORT ;; need original scheme bindings so don't trace mutated ones... (scheme-unit + - < = >= apply boolean? car cdr cons char? display eq? for-each input-port? not zero? null? number->string number? output-port? procedure? string-length string? substring symbol->string symbol? vector-length vector-ref vector? write quotient list-ref modulo length call-with-current-continuation) (implementation-specific-unit output-port-width current-error-port tmpnam force-output char-code-limit tab form-feed) ) (define (db-print . args) (let ( (result #f) ) (for-each (lambda (x) (set! result x) (write x) (display #\ )) args) (newline) result)) (define *qp-width* (output-port-width (current-output-port))) (define qpn (let ((newline newline) (apply apply)) (lambda objs (apply qp objs) (newline)))) (define qpr (lambda objs (apply qpn objs) (list-ref objs (- (length objs) 1)))) (define qp (letrec ((num-cdrs (lambda (pairs max-cdrs) (cond ((null? pairs) 0) ((< max-cdrs 1) 1) ((pair? pairs) (+ 1 (num-cdrs (cdr pairs) (- max-cdrs 1)))) (else 1)))) (l-elt-room (lambda (room pairs) (quotient room (num-cdrs pairs (quotient room 8))))) (qp-pairs (lambda (cdrs room) (cond ((null? cdrs) 0) ((not (pair? cdrs)) (display " . ") (+ 3 (qp-obj cdrs (l-elt-room (- room 3) cdrs)))) ((< 11 room) (display #\ ) ((lambda (used) (+ (qp-pairs (cdr cdrs) (- room used)) used)) (+ 1 (qp-obj (car cdrs) (l-elt-room (- room 1) cdrs))))) (else (display " ...") 4)))) (v-elt-room (lambda (room vleft) (quotient room (min vleft (quotient room 8))))) (qp-vect (lambda (vect i room) (cond ((= (vector-length vect) i) 0) ((< 11 room) (display #\ ) ((lambda (used) (+ (qp-vect vect (+ i 1) (- room used)) used)) (+ 1 (qp-obj (vector-ref vect i) (v-elt-room (- room 1) (- (vector-length vect) i)))))) (else (display " ...") 4)))) (qp-string (lambda (str room) (cond ((>= (string-length str) room 3) (display (substring str 0 (- room 3))) (display "...") room) (else (display str) (string-length str))))) (qp-obj (lambda (obj room) (cond ((null? obj) (write obj) 2) ((boolean? obj) (write obj) 2) ((char? obj) (write obj) 8) ((number? obj) (qp-string (number->string obj) room)) ((string? obj) (display #\") ((lambda (ans) (display #\") ans) (+ 2 (qp-string obj (- room 2))))) ((symbol? obj) (qp-string (symbol->string obj) room)) ((input-port? obj) (display "#[input]") 8) ((output-port? obj) (display "#[output]") 9) ((procedure? obj) (display "#[proc]") 7) ((vector? obj) (set! room (- room 3)) (display "#(") ((lambda (used) (display #\)) (+ used 3)) (cond ((= 0 (vector-length obj)) 0) ((< room 8) (display "...") 3) (else ((lambda (used) (+ (qp-vect obj 1 (- room used)) used)) (qp-obj (vector-ref obj 0) (v-elt-room room (vector-length obj)))))))) ((pair? obj) (set! room (- room 2)) (display #$) ((lambda (used) (display #$) (+ 2 used)) (if (< room 8) (begin (display "...") 3) ((lambda (used) (+ (qp-pairs (cdr obj) (- room used)) used)) (qp-obj (car obj) (l-elt-room room obj)))))) (else (display "#[unknown]") 10))))) (lambda objs (qp-pairs (cdr objs) (- *qp-width* (qp-obj (car objs) (l-elt-room *qp-width* objs))))))) (define indent 0) (define tracef (lambda (function . optname) (set! indent 0) (let ((name (if (null? optname) function (car optname)))) (lambda args (cond ((and (not (null? args)) (eq? (car args) 'untrace-object) (null? (cdr args))) function) (else (do ((i indent (+ -1 i))) ((zero? i)) (display #\ )) (apply qpn "CALLED" name args) (set! indent (modulo (+ 1 indent) 8)) (let ((ans (apply function args))) (set! indent (modulo (+ -1 indent) 8)) (do ((i indent (+ -1 i))) ((zero? i)) (display #\ )) (qpn "RETURNED" name ans) ans))))))) ;;; the reason I use a symbol for untrace-object is so ;;; that functions can still be untraced if this file is read in twice. (define (untracef function) (set! indent 0) (function 'untrace-object)) ;;;; BREAKPOINTS ;;; Typing (init-debug) at top level sets up a continuation for break. ;;; When (break arg1 ...) is then called it returns from the top level ;;; continuation and pushes the continuation from which it was called ;;; on break-continuation-stack. If (continue) is later ;;; called, it pops the topmost continuation off of ;;; break-continuation-stack and returns #f to it. (define break-continuation-stack '()) (define break (lambda args (apply qpn "BREAK:" args) (call-with-current-continuation (lambda (x) (set! break-continuation-stack (cons x break-continuation-stack)) (top-continuation (length break-continuation-stack)))))) (define continue (lambda any (cond ((null? break-continuation-stack) #f) (else (let ((cont (car break-continuation-stack))) (set! break-continuation-stack (cdr break-continuation-stack)) (cont (if (null? any) #f (car any)))))))) (define top-continuation (if (provided? 'abort) (lambda (val) (display val) (newline) (abort)) ; (begin (display "; type ((unit-lookup debug-unit 'init-debug))") ; (newline) #f ; ) ) ) (define (init-debug) (call-with-current-continuation (lambda (x) (set! top-continuation x)))) (EXPORT db-print qp qpn qpr tracef untracef break continue init-debug) ) ; global side effects (define BREAK (unit-lookup debug-unit 'break)) (define CONTINUE (unit-lookup debug-unit 'continue)) ;; UNCOMMENT THE FOLLOWING IF YOUR SYSTEM DOES NOT SUPPLY TRACE (define TRACEF (unit-lookup debug-unit 'tracef)) (define UNTRACEF (unit-lookup debug-unit 'untracef)) (define-syntax TRACE (syntax-rules '() ((trace ) ; => (define (tracef '))) ) ) (define-syntax UNTRACE (syntax-rules '() ((untrace ) ; => (define (untracef ))) ) ) ;; N.B. Don't forget to invoke ((unit-lookup debug-unit 'init-debug)) in ;; your top-level context. ; --- E O F ---