--- oaklisp-1.3.3.orig/README +++ oaklisp-1.3.3/README @@ -1,4 +1,9 @@ This is the Oaklisp source distribution. + +Oaklisp's home is: +http://oaklisp.alioth.debian.org/ + +Old releases are still at: See http://www-bcl.cs.may.ie/~barak/oaklisp/ for updates. --- oaklisp-1.3.3.orig/debian/rules +++ oaklisp-1.3.3/debian/rules @@ -0,0 +1,34 @@ +#!/usr/bin/make -f + +# Uncomment this to turn on verbose mode. +# export DH_VERBOSE=1 + +build clean binary-arch binary-indep binary: + dh $@ --parallel + +.PHONY: build clean binary-arch binary-indep binary + +CFLAGS += -g -Wall +CPPFLAGS += -DFAST + +ifneq (,$(findstring noopt,$(DEB_BUILD_OPTIONS))) +CFLAGS += -O3 +endif + +ifeq ($(shell dpkg-architecture -qDEB_BUILD_ARCH_CPU),amd64) +CFLAGS += -m32 +LDFLAGS += -m32 +endif + +export CFLAGS +export CPPFLAGS +export LDFLAGS + +prefix=/usr +DESTDIR=`pwd`/debian/oaklisp + +override_dh_auto_build: + dh_auto_build -- prefix=$(prefix) + +override_dh_auto_install: + $(MAKE) -C src DESTDIR=$(DESTDIR) prefix=$(prefix) install --- oaklisp-1.3.3.orig/debian/control +++ oaklisp-1.3.3/debian/control @@ -0,0 +1,32 @@ +Source: oaklisp +Section: lisp +Priority: extra +Maintainer: Barak A. Pearlmutter +Standards-Version: 3.9.1 +Build-depends: + oaklisp, + debhelper (>= 8), + texlive-latex-base, texlive-latex-extra, texlive-fonts-recommended, + ghostscript, + libc6-dev-i386 [amd64] +Homepage: http://oaklisp.alioth.debian.org/ +Vcs-Git: git://scm.alioth.debian.org/git/oaklisp/oaklisp.git +Vcs-Browser: https://alioth.debian.org/scm/browser.php?group_id=100056 + +Package: oaklisp +Architecture: i386 amd64 +Depends: ${shlibs:Depends}, ${misc:Depends} +Description: An object-oriented dialect of Scheme + Oaklisp is a dialect of Scheme that combines lexical scoping with + first-class types. It uses a byte-coded implementation, but is + reasonably fast anyway. Complete with bignums, formatted output, + transparent delays, RnRS compatibility package; all the luxuries + except floating point and foreign function calls. + +Package: oaklisp-doc +Section: doc +Architecture: all +Depends: ${misc:Depends} +Suggests: oaklisp, postscript-viewer +Description: Documentation for the Oaklisp dialect of Scheme + Documentation for the Oaklisp object-oriented dialect of Scheme. --- oaklisp-1.3.3.orig/debian/TODO +++ oaklisp-1.3.3/debian/TODO @@ -0,0 +1 @@ + * solve bootstrapping issue (closes: #122117) --- oaklisp-1.3.3.orig/debian/oaklisp.manpages +++ oaklisp-1.3.3/debian/oaklisp.manpages @@ -0,0 +1 @@ +man/man1/oaklisp.1 --- oaklisp-1.3.3.orig/debian/dirs +++ oaklisp-1.3.3/debian/dirs @@ -0,0 +1,4 @@ +usr/bin +usr/lib/oaklisp +usr/share/man/man1 +usr/share/doc/oaklisp --- oaklisp-1.3.3.orig/debian/oaklisp-doc.doc-base.2 +++ oaklisp-1.3.3/debian/oaklisp-doc.doc-base.2 @@ -0,0 +1,9 @@ +Document: oaklisp-lim +Title: Oaklisp Implementation Manual +Author: Barak A. Pearlmutter and Kevin J. Lang +Abstract: Description of the implementation internals of the Oaklisp + language, for those who wish to modify or extend the implementation. +Section: Programming/Scheme + +Format: PDF +Files: /usr/share/doc/oaklisp-doc/lim.pdf.gz --- oaklisp-1.3.3.orig/debian/copyright +++ oaklisp-1.3.3/debian/copyright @@ -0,0 +1,22 @@ +This package was released by Barak A. Pearlmutter on +Fri, 7 Jan 2000 04:29:57 -0500. + +This package was debian-helper-ized by tony mancill on +Tue, 15 Feb 2000 21:03:25 -0700. + +The current Debian Maintainer is Barak A. Pearlmutter + +Upstream sources (which include Debian packaging files) are available at +http://oaklisp.alioth.debian.org/ +see also http://www.bcl.hamilton.ie/~barak/oaklisp/ + +Upstream Authors: Kevin J. Lang, Barak A. Pearlmutter + +Copyright 1985-2008 Barak A. Pearlmutter and Kevin J. Lang + +License: + + The GNU General Public License as published by the Free Software + Foundation; either version 2 or (at your option) any later version. + On Debian systems, the complete text of the GNU General Public + License version 2 can be found in /usr/share/common-licenses/GPL-2. --- oaklisp-1.3.3.orig/debian/README.Debian +++ oaklisp-1.3.3/debian/README.Debian @@ -0,0 +1,7 @@ +The Debian Package oaklisp +---------------------------- + +An object-oriented dialect of Scheme with first-class types. +http://oaklisp.alioth.debian.org/ + + -- Barak A. Pearlmutter , Wed, 6 Feb 2008 19:53:18 +0000 --- oaklisp-1.3.3.orig/debian/changelog +++ oaklisp-1.3.3/debian/changelog @@ -0,0 +1,63 @@ +oaklisp (1.3.3-5) unstable; urgency=low + + * build dependency on ghostscript for ps2pdf + + -- Barak A. Pearlmutter Thu, 06 Jan 2011 23:17:58 +0000 + +oaklisp (1.3.3-4) unstable; urgency=low + + * track change to Alioth's vcs-browser url + * pass -m32 on amd64 + * bump debian policy + * dh 8 + * latex changed, build depend on texlive-fonts-recommended (closes: #608376) + * swizzle Vcs-* fields in debian/control from old CVS to new git repo + * documentation in PDF instead of PostScript + * update/simplify debian/rules + + -- Barak A. Pearlmutter Fri, 31 Dec 2010 00:07:14 -0500 + +oaklisp (1.3.3-3) unstable; urgency=low + + * include home page in control file + * change priority from optional to extra + * modernise update menu section + * rev deb policy + * new section: lisp + * debian/control vcs and homepage fields + + -- Barak A. Pearlmutter Tue, 17 Mar 2009 21:38:03 +0000 + +oaklisp (1.3.3-2) unstable; urgency=low + + * rewrite debian/copyright according to the arbitrary whims of the + ftpmasters without increasing its information content or usefulness + * raise debhelper level to 7 + + -- Barak A. Pearlmutter Wed, 23 Jul 2008 22:15:36 +0200 + +oaklisp (1.3.3-1) unstable; urgency=low + + * tetex-extra build dependency (closes: #136821) + * remove silly build dependency on etags + * patch from Len Sorensen for ARM architecture (closes: #306810) + * patch from Ben Collins for m68k and SPARC (see #87535) + * patch from Barry deFreese for m68k (see #65886) + * general moving stuff around + * restrict architecture to i386 (closes: #65886, #87535, #122117) + * rev deb policy + * back from the dead! (closes: #328597) + + -- Barak A. Pearlmutter Mon, 14 Jul 2008 10:59:59 +0100 + +oaklisp (1.3.2) unstable; urgency=low + + * Patch for 68000. Build dependency. Split out documentation. + + -- Barak A. Pearlmutter Sun, 31 Dec 2000 13:06:21 -0500 + +oaklisp (1.3.1) unstable; urgency=low + + * Initial Release. + + -- Barak A. Pearlmutter Fri, 7 Jan 2000 04:29:57 -0500 --- oaklisp-1.3.3.orig/debian/menu +++ oaklisp-1.3.3/debian/menu @@ -0,0 +1,4 @@ +?package(oaklisp): needs="text" \ + section="Applications/Programming" \ + title="Oaklisp" \ + command="/usr/bin/oaklisp" --- oaklisp-1.3.3.orig/debian/oaklisp-doc.install +++ oaklisp-1.3.3/debian/oaklisp-doc.install @@ -0,0 +1 @@ +doc/*/*.pdf usr/share/doc/oaklisp-doc --- oaklisp-1.3.3.orig/debian/docs +++ oaklisp-1.3.3/debian/docs @@ -0,0 +1 @@ +README --- oaklisp-1.3.3.orig/debian/oaklisp-doc.doc-base.1 +++ oaklisp-1.3.3/debian/oaklisp-doc.doc-base.1 @@ -0,0 +1,8 @@ +Document: oaklisp-lang +Title: Oaklisp Language Manual +Author: Barak A. Pearlmutter and Kevin J. Lang +Abstract: Description of the Oaklisp language for programmers. +Section: Programming/Scheme + +Format: PDF +Files: /usr/share/doc/oaklisp-doc/lang.pdf.gz --- oaklisp-1.3.3.orig/debian/oaklisp-doc.docs +++ oaklisp-1.3.3/debian/oaklisp-doc.docs @@ -0,0 +1 @@ +debian/README-BUILDING.Debian --- oaklisp-1.3.3.orig/debian/compat +++ oaklisp-1.3.3/debian/compat @@ -0,0 +1 @@ +8 --- oaklisp-1.3.3.orig/debian/README-BUILDING.Debian +++ oaklisp-1.3.3/debian/README-BUILDING.Debian @@ -0,0 +1,38 @@ +Because Oaklisp uses itself to build itself, there is a bootstrap problem +with trying to build it completely "from scratch." +Therefore, the package has a build dependency upon itself - i.e. you have +to have the binary package installed to be able to build the package. + +Actually the situation is not as bad as for, say, gcc, which requires +heroic effort to compile for a machine without a working C compiler. +This is because the oaklisp compiler produces architecture-neutral +bytecode as its output. However, the "binary world" loaded by the +bytecode emulator is endianity-dependent. + + +Basically, to port to a new architecture Y with *the same endianity* as +a machine X of a different architecture which has a working oaklisp, +do the following: + + rebuild everything on X + move the entire source tree to Y + cd src/emulator; make clean + +now go ahead and build and package, everything should be okay + + +If X and Y have different endianities, you're still okay. Do +everything as above, except after you copy the tree do the following +additional steps + + cd src/emulator; make clean + cd src/world; rm *.bin + +In a pinch, you only need the following file to be able to do the build: + /usr/lib/oaklisp/oakworld.bin + +However, the file must be for the correct "endian-ness" of your machine. +Please contact either the upstream author or the maintainer if you need this +file or have questions. + + -- Barak A. Pearlmutter , Thu, 30 Dec 2010 17:45:13 -0500 --- oaklisp-1.3.3.orig/man/man1/oaklisp.1 +++ oaklisp-1.3.3/man/man1/oaklisp.1 @@ -4,17 +4,17 @@ oaklisp \- An implementation of the Oaklisp language \" This file is part of Oaklisp. -\" +\" \" This program is free software; you can redistribute it and/or modify \" it under the terms of the GNU General Public License as published by \" the Free Software Foundation; either version 2 of the License, or \" (at your option) any later version. -\" +\" \" This program is distributed in the hope that it will be useful, \" but WITHOUT ANY WARRANTY; without even the implied warranty of \" MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the \" GNU General Public License for more details. -\" +\" \" The GNU GPL is available at http://www.gnu.org/licenses/gpl.html \" or from the Free Software Foundation, 59 Temple Place - Suite 330, \" Boston, MA 02111-1307, USA --- oaklisp-1.3.3.orig/src/emulator/loop.c +++ oaklisp-1.3.3/src/emulator/loop.c @@ -331,7 +331,7 @@ LOCALIZE_ALL(); - /* This fixes a bug in which the initial CHECK-NARGS + /* This fixes a bug in which the initial CHECK-NARGS in the boot code tries to pop the operation and fails. */ PUSHVAL_IMM(INT_TO_REF(4321)); @@ -2030,7 +2030,7 @@ op_field, arg_field); #endif - /* Back off of the current intruction so it will get executed + /* Back off of the current intruction so it will get executed when we get back from the trap code. */ local_epc--; --- oaklisp-1.3.3.orig/src/emulator/Makefile +++ oaklisp-1.3.3/src/emulator/Makefile @@ -30,8 +30,8 @@ all: $(progs) -CFLAGS=-O2 -g -Wall -LOADLIBES=-lpthread +CFLAGS += -O2 -g -Wall +LOADLIBES = -lpthread OAK=oaklisp @@ -76,5 +76,5 @@ -rm -f $(progs) $(psrc:.c=.o) $(osrc:.c=.o) $(dfiles) TAGS .PHONY: indent -indent: $(psrc) $(osrc) $(hsrc) +indent: $(psrc) $(osrc) $(hsrc) indent --no-space-after-casts --no-space-after-function-call-names $^ --- oaklisp-1.3.3.orig/src/emulator/stacks.c +++ oaklisp-1.3.3/src/emulator/stacks.c @@ -220,7 +220,7 @@ int *my_index_p; int my_index; #endif - + ref_t *ptr; /* For debugging we allocate two ref_t more @@ -233,7 +233,7 @@ my_index_p = pthread_getspecific (index_key); my_index = *my_index_p; #endif - + ptr = (ref_t *) xmalloc((value_stack.size + 2) * sizeof(ref_t)); *ptr = PATTERN; @@ -248,7 +248,7 @@ /* Initialise context stack */ - + ptr = (ref_t *) xmalloc((context_stack.size + 2) * sizeof(ref_t)); *ptr = PATTERN; --- oaklisp-1.3.3.orig/src/emulator/gc.c +++ oaklisp-1.3.3/src/emulator/gc.c @@ -42,8 +42,8 @@ -/* 1/RECLAIM_FACTOR is the target for how much of new space should - be used after a gc. If more than this is used, the next new +/* 1/RECLAIM_FACTOR is the target for how much of new space should + be used after a gc. If more than this is used, the next new space allocated will be bigger. */ #define RECLAIM_FACTOR 3 @@ -821,7 +821,7 @@ my_index = *my_index_p; gc_ready[my_index] = 0; set_gc_flag (false); -#endif +#endif } --- oaklisp-1.3.3.orig/src/emulator/stacks-loop.h +++ oaklisp-1.3.3/src/emulator/stacks-loop.h @@ -176,8 +176,8 @@ context_stack.segment = e_nil; \ } -/* This pops some elements off the value stack. - It is inefficient because it copies elements into the buffer +/* This pops some elements off the value stack. + It is inefficient because it copies elements into the buffer and then pops them off. A better thing should be written. */ #define POPVALS(n) \ { CHECKVAL_POP((n)); \ --- oaklisp-1.3.3.orig/src/emulator/cmdline.c +++ oaklisp-1.3.3/src/emulator/cmdline.c @@ -133,7 +133,7 @@ my_index_p = pthread_getspecific (index_key); my_index = *my_index_p; #endif - + { char *w = getenv("OAKWORLD"); if (w) world_file_name = w; --- oaklisp-1.3.3.orig/src/world/tag-trap.oak +++ oaklisp-1.3.3/src/world/tag-trap.oak @@ -39,7 +39,7 @@ (lambda ( . args) (listify-args aux i . args))))) - + (let ((aux (lambda (args) (destructure (i arg . args) args --- oaklisp-1.3.3.orig/src/world/complex.oak +++ oaklisp-1.3.3/src/world/complex.oak @@ -22,7 +22,7 @@ ;;; ;;; Complex numbers! Oh boy! -;;; +;;; (define-instance complex type '(the-real-part the-imag-part) (list number object)) --- oaklisp-1.3.3.orig/src/world/mac-compiler1.oak +++ oaklisp-1.3.3/src/world/mac-compiler1.oak @@ -71,7 +71,7 @@ ;this handy variant fills in the enclosing-contour slots -;of code to be inserted in the tree. +;of code to be inserted in the tree. (define (addedcode->ast form model-node) (let ((new-ast (code->ast form))) (stash-enclosing-contour new-ast (node-enclosing-contour model-node)) --- oaklisp-1.3.3.orig/src/world/load-file.oak +++ oaklisp-1.3.3/src/world/load-file.oak @@ -106,7 +106,7 @@ locale (with-open-file (s (append file ".oa") in) (make-oa-list (read-oaf-list s))))) - + #|| (define (load-oa-file locale file) @@ -157,7 +157,7 @@ 'loaded)) - + (define (load-omac-file locale file) (dofile (append file ".omac") --- oaklisp-1.3.3.orig/src/world/Makefile +++ oaklisp-1.3.3/src/world/Makefile @@ -99,7 +99,8 @@ .PHONY: clean clean: clean-oa-files - -rm -f oakworld{-1,-2,-3}.bin new.cold new.sym + -rm -f oakworld-1.bin oakworld-2.bin oakworld-3.bin + -rm -f new.cold new.sym .PHONY: clean-oa-files clean-oa-files: --- oaklisp-1.3.3.orig/src/world/prolog-examples.oak +++ oaklisp-1.3.3/src/world/prolog-examples.oak @@ -39,7 +39,7 @@ (p-length () 0)) ((a x j i) (p-length (,a . ,x) ,i) :- (p-length ,x ,j) (is ,i ,(+ j 1))))) - + (labels ((p-reverse3 @@ -61,7 +61,7 @@ (p-delete ,x (,x . ,l) ,l)) ((x y z l) (p-delete ,x (,y . ,l) (,y . ,z)) :- (p-delete ,x ,l ,z)))) - + @@ -191,7 +191,7 @@ ; This loops after finding one solution when used in right-to-left mode. -; Putting a cut in the first clause would cause it to find no solutions. +; Putting a cut in the first clause would cause it to find no solutions. ; This behavior is consistent with quintus prolog. @@ -215,7 +215,7 @@ (() (weird-reverse () ())) ((a x x1 y) (weird-reverse (,a . ,x) ,y) :- (weird-reverse ,x ,x1) (oak-append ,y ,x1 (,a))))) - + @@ -374,8 +374,8 @@ ; This creates a prolog relation of arity N+1 from an oaklisp function of arity N. ; The prolog relation applies the oaklisp function to its LAST N arguments, ; and then returns the result by unifying it with its FIRST argument. -; This facility currently doesn't work very well, since not all functions -; in oaklisp have been written to accept delayed objects. +; This facility currently doesn't work very well, since not all functions +; in oaklisp have been written to accept delayed objects. (define (relationify op) @@ -404,7 +404,7 @@ -; This procedure seems a bit muddled. +; This procedure seems a bit muddled. ; Try using the collect-solutions macro instead. ; (define (bagof k thing-to-bag bag-for-em rel arglist) --- oaklisp-1.3.3.orig/src/world/mac-compiler3.oak +++ oaklisp-1.3.3/src/world/mac-compiler3.oak @@ -32,7 +32,7 @@ (add-method (fold-constants-v (ast-variable-node var-type name) self locale) ; (format #t "folding ... ~a ~a ~%" self locale) - (if (and (eq? var-type 'global) + (if (and (eq? var-type 'global) (variable? locale name) (frozen? locale name)) (let ((new-node @@ -80,7 +80,7 @@ (add-method (fold-constants-v (ast-method-node ivarlist ivarmap primitivep method-type status arglist body) self locale) (map-ast-with-arg! self fold-constants-v locale) - (set! ivarmap '()) + (set! ivarmap '()) (when ivarlist (cond ((ivar-heuristic method-type ivarlist locale) => @@ -134,7 +134,7 @@ (add-method (ivar-heuristic (ast-variable-node var-type name) self ivarlist locale) (and (eq? var-type 'global) - (let ((v (variable? locale name))) + (let ((v (variable? locale name))) (and v (ivar-heuristic (contents v) ivarlist locale))))) @@ -245,11 +245,11 @@ ; '() ))) self)))) - (classify-variables wrapping) + (classify-variables wrapping) (set! op nichevo) ;these have been plugged - (set! method-type nichevo) ;into the wrapping + (set! method-type nichevo) ;into the wrapping wrapping)) - (else + (else (set! op nichevo) (set! method-type nichevo) self)))) @@ -305,7 +305,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;This operation replaces references to environment, heap, and +;This operation replaces references to environment, heap, and ;global variables with indirect references. (define-instance indirect-to-heap-v operation) @@ -340,7 +340,7 @@ (and (is-a? node ast-combination-node) (is-a? (combn-op node) ast-constant-node) (eq? contents (constn-value (combn-op node)))))) - + (add-method (fold-contents-v (ast-set-node variable expression) self) (map-ast! self fold-contents-v) (if (contents-node? variable) @@ -349,7 +349,7 @@ expression) self) self)) - + (add-method (fold-contents-v (ast-make-locative-node variable) self) (map-ast! self fold-contents-v) (if (contents-node? variable) @@ -399,14 +399,14 @@ (with-operations (proceed) - + (add-method (stash-stack-map (ast-node stack-map) self outer-map) (set! stack-map outer-map) (proceed self outer-map)) - + (add-method (proceed (ast-node stack-map) self outer-map) (walk-ast-with-arg self stash-stack-map outer-map)) - + (add-method (proceed (ast-method-node arglist body status inlabels?) self outer-map) ;beware hack: if it's a real inline lambda , (a b)+(0 0 x y)->(a b x y) @@ -418,17 +418,17 @@ (tail outer-map (length arglist)))) arglist))) (stash-stack-map body newmap))) - + (add-method (proceed (ast-set-node variable expression) self outer-map) (stash-stack-map expression outer-map) (stash-stack-map variable (cons 0 outer-map))) - + (add-method (proceed (ast-combination-node op args rest-name) self outer-map) (let ((backwards? (and (is-a? op ast-constant-node) (is-a? (constn-value op) open-coded-mixin) (is-a? (constn-value op) backwards-args-mixin) (eq? rest-name nichevo)))) - + (iterate step ((stack-map outer-map) (arglist (if backwards? args (reverse args)))) (cond ((null? arglist) --- oaklisp-1.3.3.orig/src/world/load-oaf.oak +++ oaklisp-1.3.3/src/world/load-oaf.oak @@ -134,7 +134,7 @@ (define (read-oaf-list stream) (read-list-using-functions stream - (list read + (list read (lambda (stream) ;list of body clauses (read-list-using-functions stream --- oaklisp-1.3.3.orig/src/world/undefined.oak +++ oaklisp-1.3.3/src/world/undefined.oak @@ -50,7 +50,7 @@ (define (make-undefined-variable-value sym) (make undefined (append "variable " (#^string sym)))) -;;; +;;; (define (setup-undefined-ivar) (set! ((%register 'uninitialized)) ivar-undefined-value) --- oaklisp-1.3.3.orig/src/world/destructure.oak +++ oaklisp-1.3.3/src/world/destructure.oak @@ -57,7 +57,7 @@ (if (pair? ,v) ,inner ,(noper v pattern))) `(let ((,v ,expr)) ,inner)))))) - + ;;; This is for destructuring lists. As in ;;; (destructure (a (b c) (d . e) f) my-list --- oaklisp-1.3.3.orig/src/world/prolog.oak +++ oaklisp-1.3.3/src/world/prolog.oak @@ -38,7 +38,7 @@ ;;; like a function call; calls to normal Oaklisp predicates, notated ;;; by a comma followed by the call; and Prolog style cuts, notated by ;;; an !. Calls to normal oaklisp predicates affect the control flow -;;; in the same way as calls to prolog relations. +;;; in the same way as calls to prolog relations. ;;; Within calls to other relations, logic variables are preceded by @@ -51,24 +51,24 @@ ;;; may be accessed normally. ;;; Within any Oaklisp code, bound logic variables are transparently ;;; and silently replaced by their values when appropriate, so no -;;; machinations should be necessary. +;;; machinations should be necessary. ;;; [Actually, your program will run faster if bound logic variables -;;; are explicitly derefenced before being passed to oaklisp code. +;;; are explicitly derefenced before being passed to oaklisp code. ;;; You can do this using using follow-chain if you know that ;;; following the chain of variables will lead to an atomic value such as ;;; a number, or deep-copy if the variable is bound to a more complicated ;;; data structure containing cons cells as well as logic variables.] -;;; As a special dispensation, Oaklisp set! forms are allowed to appear in -;;; the right hand side to provide a faster version of part of the -;;; functionality of the prolog relation "is". A set! clause is -;;; performed for effect only and control is then passed to the clause to the +;;; As a special dispensation, Oaklisp set! forms are allowed to appear in +;;; the right hand side to provide a faster version of part of the +;;; functionality of the prolog relation "is". A set! clause is +;;; performed for effect only and control is then passed to the clause to the ;;; right regardless of the value to which the variable has been bound. -;;; Set! should only be used to calculate initial values for temporary RHS +;;; Set! should only be used to calculate initial values for temporary RHS ;;; variables that will be then used in clauses that are further to the right. ;;; It cannot be used to pass values back to the caller of the relation -;;; through LHS variables; for that purpose, one must use the "is" relation +;;; through LHS variables; for that purpose, one must use the "is" relation ;;; to unify the LHS variable with the new value. @@ -218,7 +218,7 @@ (define (deep-copy x) (let ((x (follow-chain x))) - (cond ((eq? x _) _) + (cond ((eq? x _) _) ((logic-variable? x) x) ; used to be (make regular-logic-variable) ((pair? x) (let ((a (deep-copy (car x))) @@ -240,8 +240,8 @@ ; Use this macro if you want prolog to just run through the various -; solutions without doing anything with them. This is useful for -; benchmarking, or when oaklisp side effects are used inside the +; solutions without doing anything with them. This is useful for +; benchmarking, or when oaklisp side effects are used inside the ; prolog program to record the answers. @@ -460,7 +460,7 @@ (iterate aux () (format #t "~A? " prompt) (flush standard-output) - (flush standard-input) + (flush standard-input) (let ((c (read-char standard-input))) (cond ((eq? c #\newline) #t) ((eq? c #\y) (read-char standard-input) #t) @@ -580,8 +580,8 @@ -(define (is k x y) - (unify x y k)) +(define (is k x y) + (unify x y k)) @@ -609,7 +609,7 @@ (define (analyse-lhs-variables input-list) (let* ((vars-to-copy '()) (seen-it '()) - (hacked-list + (hacked-list (map (lambda (expr expr-no) (if (comma-expr? expr) (let ((the-variable (cadr expr))) @@ -621,7 +621,7 @@ vars-to-copy)) (list 'unquote 'first-reference the-variable) ))) - (block + (block (set seen-it (union seen-it (all-atoms-in expr))) expr))) input-list @@ -646,13 +646,13 @@ (eq? 'first-reference (second e2))) ; the value was directly copied by hacked-with-logic-vars, ; so we don't need to unify here. - code) + code) ((or (comma-expr? e1) (comma-expr? e2)) (cond ((or (equal? e1 ',_) (equal? e2 ',_)) code) -; not always a win +; not always a win ; ((or (null? e2) (number? e2) (symbol? e2)) ; `(when (unifiable-with-constant? ,(backquotify e1) ,(backquotify e2)) ; (unify ,(backquotify e1) @@ -679,11 +679,11 @@ . body) `(let ,(map (lambda (v) (cond ((assq v lhs-vars-to-copy) - ; Copy the incoming argument now so that + ; Copy the incoming argument now so that ; we don't have to unify later. `(,v ,(nth formal-list (cdr (assq v lhs-vars-to-copy))))) ((memq v rhs-vars-to-set) - ; we are going to assign a value later with set!, + ; we are going to assign a value later with set!, ; we don't need to make a logic variable now. `(,v variable-undefined-value)) (else @@ -738,7 +738,7 @@ (set #*rhs-vars-to-set (cons (second (second (car rhs))) #*rhs-vars-to-set)) `(block ,(second (car rhs)) ,munched-rest)) - + ((comma-expr? (car rhs)) `(when ,(cadar rhs) ,munched-rest)) @@ -748,17 +748,17 @@ ,(lambdify munched-rest) ,@(map backquotify (cdar rhs)))))))) - + ; (define-instance unifiable-with-constant? operation) -; +; ; (add-method (unifiable-with-constant? (regular-logic-variable flag val) ; self the-constant) ; (if flag ; (unifiable-with-constant? val the-constant) -; #t)) +; #t)) ; ; (add-method (unifiable-with-constant? (object) self the-constant) ; (eq? self the-constant)) --- oaklisp-1.3.3.orig/src/world/mac-compiler2.oak +++ oaklisp-1.3.3/src/world/mac-compiler2.oak @@ -34,11 +34,11 @@ (mark-tail-nodes astree))) (top-level-resolve-variables astree)))) - + (add-method (expand-compile (locale) self form) (compile self (block0 (expand-groveling self form) (print-sp 'mac)))) - + (add-method (compile (locale) self form) (bind ((#*labels-count 0) @@ -58,7 +58,7 @@ (annotate-the-tree astree) (print-sp 'ann) (step #*labels-count)))) - (set! astree (fold-constants-v astree self)) + (set! astree (fold-constants-v astree self)) (print-sp 'fold) (when #*contour-nodes? (set! astree (insert-method-maker-v astree))) @@ -92,7 +92,7 @@ (define-instance mark-inline-lambdas operation) -(with-operations (you-are-in-car-pos) +(with-operations (you-are-in-car-pos) (add-method (mark-inline-lambdas (ast-node) self) (walk-ast self mark-inline-lambdas)) @@ -110,7 +110,7 @@ (you-are-in-car-pos op)) (add-method (mark-inline-lambdas (ast-labels-node lambdalist) self) - (walk-ast self mark-inline-lambdas) + (walk-ast self mark-inline-lambdas) ;; These guys must be marked as inline, (for-each you-are-in-car-pos lambdalist) ;; and inlabels. @@ -134,19 +134,19 @@ (if (and (null? ivarlist) ;No ivars. (and (is-a? op ast-combination-node) (is-a? (combn-op op) ast-variable-node) - (equal? (varn-name (combn-op op)) 'make) ;Operation is made at + (equal? (varn-name (combn-op op)) 'make) ;Operation is made at (= 1 (length (combn-args op))) ;installation time. (is-a? (car (combn-args op)) ast-variable-node) - (equal? (varn-name (car (combn-args op))) 'operation)) + (equal? (varn-name (car (combn-args op))) 'operation)) (is-a? method-type ast-variable-node) ;Method is for object. (equal? 'object (varn-name method-type))) ; (set! status 'inline))) (add-method (you-are-in-car-pos (ast-method-node status op ivarlist method-type) self) (if (and (null? ivarlist) ;No ivars. (and (is-a? op ast-combination-node) - (equal? (combn-op op) make);Operation is made at - (= 1 (length (combn-args op)));installation time. - (equal? (car (combn-args op)) operation)) + (equal? (combn-op op) make);Operation is made at + (= 1 (length (combn-args op)));installation time. + (equal? (car (combn-args op)) operation)) (is-a? method-type ast-constant-node);Method is for object. (eq? object (constn-value method-type))) (set! status 'inline))) @@ -164,7 +164,7 @@ (add-method (contn-transparent? (ast-method-node status) self) (eq? status 'inline)) - + (add-method (contn-transparent? (ast-labels-node) self) t) @@ -176,11 +176,11 @@ (define-instance mark-tail-nodes operation) -(with-operations (you-are-in-tail-pos) - +(with-operations (you-are-in-tail-pos) + (add-method (mark-tail-nodes (ast-node) self) (walk-ast self mark-tail-nodes)) - + (add-method (mark-tail-nodes (ast-labels-node) self) (walk-ast self mark-tail-nodes) (you-are-in-tail-pos self)) @@ -188,24 +188,24 @@ (add-method (mark-tail-nodes (ast-combination-node tail-pos?) self) (set! tail-pos? nil) ;erase previous analysis (walk-ast self mark-tail-nodes)) - + (add-method (you-are-in-tail-pos (ast-node) self) nil) ;no-op - + (add-method (you-are-in-tail-pos (ast-if-node consequent alternate) self) (you-are-in-tail-pos consequent) (you-are-in-tail-pos alternate)) - + (add-method (you-are-in-tail-pos (ast-labels-node) self) (walk-ast self you-are-in-tail-pos)) - + (add-method (you-are-in-tail-pos (ast-block-node body) self) (you-are-in-tail-pos (last body))) - + (add-method (you-are-in-tail-pos (ast-combination-node op tail-pos?) self) (set! tail-pos? t) (if (is-a? op ast-method-node) (you-are-in-tail-pos op))) ;so that LET will work. - + (add-method (you-are-in-tail-pos (ast-method-node status body) self) (if (eq? status 'inline) (you-are-in-tail-pos body)))) @@ -239,7 +239,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;The environment slot of a contour node contains a list of all ;external lexical variables that are visible in that method. - + (define-instance stash-environment operation) (add-method (stash-environment (ast-node) self outer-env) @@ -248,13 +248,13 @@ (add-method (stash-environment (ast-contour-node localvars environment) self outer-env) (set! environment outer-env) (append localvars outer-env)) - + (add-method (stash-environment (ast-method-node method-type op body) self outer-env) (let ((new-env (^super ast-contour-node stash-environment self outer-env))) (stash-environment method-type outer-env) (stash-environment op outer-env) (stash-environment body new-env))) - + (add-method (stash-environment (ast-labels-node lambdalist body) self outer-env) (let ((new-env (^super ast-contour-node stash-environment self outer-env))) (map-with-arg stash-environment lambdalist new-env) @@ -263,16 +263,16 @@ #| (with-operations (proceed) - + (add-method (stash-environment (ast-contour-node localvars environment) self outer-env) (set! environment outer-env) (proceed self outer-env (append localvars outer-env))) - + (add-method (proceed (ast-method-node method-type op body) self outer-env new-env) (stash-environment method-type outer-env) (stash-environment op outer-env) (stash-environment body new-env)) - + (add-method (proceed (ast-labels-node lambdalist body) self outer-env new-env) (map-with-arg stash-environment lambdalist new-env) (stash-environment body new-env))) @@ -289,14 +289,14 @@ (with-operations (proceed) - + (add-method (stash-enclosing-contour (ast-node enclosing-contour) self enc-cont) (set! enclosing-contour enc-cont) (proceed self enc-cont)) - + (add-method (proceed (ast-node) self enc-cont) (walk-ast-with-arg self stash-enclosing-contour enc-cont)) - + (add-method (proceed (ast-method-node method-type op body) self enc-cont) (stash-enclosing-contour method-type enc-cont) (stash-enclosing-contour op enc-cont) @@ -319,7 +319,7 @@ (walk-ast self classify-variables)) (add-method (classify-variables (ast-variable-node - var-type name source-contour) self) + var-type name source-contour) self) (iterate step ((contour (node-enclosing-contour self))) (cond ((memq name (contn-localvars contour)) @@ -344,11 +344,11 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;This operation notices evars and records them in the envlist +;This operation notices evars and records them in the envlist ;field of their enclosing methods. ;If a method cannot supply a variable closed over by an ;inner method, then the variable must be closed over by -;the outer method too. +;the outer method too. ;This also fills in the nojumplist field of contours. @@ -395,10 +395,10 @@ (define-instance rewrite-labels-v operation) (with-operations (look-for-non-tail-call your-out-of-place) - + (add-method (rewrite-labels-v (ast-node) self) (map-ast! self rewrite-labels-v)) - + (add-method (rewrite-labels-v (ast-labels-node labellist lambdalist body) self) (map-ast! self rewrite-labels-v) (look-for-non-tail-call self) @@ -407,7 +407,7 @@ (block (set! #*labels-count (- #*labels-count 1)) (code->ast - `((%add-method ((',make ',operation) (',object) . ,labellist) ;see below + `((%add-method ((',make ',operation) (',object) . ,labellist) ;see below (%block ,@(map2 (lambda (lab lam) `(%set ,lab ,lam)) @@ -417,11 +417,11 @@ ,@(map (lambda (x) nil) ;should really be undefined value labellist)))) self)) - + (add-method (look-for-non-tail-call (ast-node) self) (walk-ast self look-for-non-tail-call)) - + (add-method (look-for-non-tail-call (ast-combination-node op tail-pos?) self) (walk-ast self look-for-non-tail-call) (if (not tail-pos?) @@ -436,6 +436,6 @@ -;;was `((%add-method ((make operation) (object) . ,labellist) +;;was `((%add-method ((make operation) (object) . ,labellist) --- oaklisp-1.3.3.orig/src/world/crunch.oak +++ oaklisp-1.3.3/src/world/crunch.oak @@ -290,7 +290,7 @@ -; This procedure sorts the productions according to the +; This procedure sorts the productions according to the ; length of their left-hand-sides, and returns a list ; of expression matching functions, each of which only ; handles a given LHS length. @@ -301,18 +301,18 @@ (let ((hacked-crunch-list (catagorize-crunches (expand-foralls raw-crunch-list listproc)))) - (cons 'list + (cons 'list (map hash-table-hairy-code hacked-crunch-list (iota (length hacked-crunch-list)))))) -; The following procedure generates the code for a single +; The following procedure generates the code for a single ; pattern matching function which handles all of the productions ; in crunch-list (whose LHS's must be of equal length). -; The generated function uses the first opcode in its +; The generated function uses the first opcode in its ; first argument as a key for retrieving from a hash table ; a sub-function that only tries to apply the productions ; that are relevant for that opcode. @@ -355,7 +355,7 @@ ; This is Barak's procedure that combines ; a bunch of crunchers into a big labels expression -; that sequentially runs through all of the tests in +; that sequentially runs through all of the tests in ; crunch-list with no function calls. --- oaklisp-1.3.3.orig/src/world/format.oak +++ oaklisp-1.3.3/src/world/format.oak @@ -154,7 +154,7 @@ (lambda (the-list colon? atsign? char stream arg) (error "Unknown format control character ~C, argument ~S." char arg))))) - + (dotimes (i 128) (set! (nth format-control-table i) x))) --- oaklisp-1.3.3.orig/src/world/mapping.oak +++ oaklisp-1.3.3/src/world/mapping.oak @@ -223,7 +223,7 @@ ((aux1 op a list-of-lists) (cond ((null? (car list-of-lists)) a) - (else + (else (aux1 op (cons (apply op (map-and-reverse car list-of-lists)) a) @@ -332,7 +332,7 @@ ob (cdr kons))) (step (cdr kons)))) (cdr outlist))) - + #| @@ -430,7 +430,7 @@ #| -; replaced by new definitions that +; replaced by new definitions that ; take a variable number of arguments (add-method (append (pair) a b) @@ -547,7 +547,7 @@ (add-method (append! (pair) . rest) (cond ((= 2 (rest-length rest)) (append!-aux2 . rest)) ((= 3 (rest-length rest)) (append!-aux3 . rest)) - ((= 1 (rest-length rest)) (append!-aux1 . rest)) + ((= 1 (rest-length rest)) (append!-aux1 . rest)) (else (backwards-listify-args append!-aux-gen . rest)))) @@ -564,8 +564,8 @@ -; Unless there are zero arguments, calls to append that invoke -; the method for object will call the error handling system, which +; Unless there are zero arguments, calls to append that invoke +; the method for object will call the error handling system, which ; will force delayed values if necessary, or else report an error. @@ -671,17 +671,17 @@ (define-instance local-method settable-operation) (let ((local-method0 (make settable-operation))) - + (add-method (local-method (operation) op typ) (local-method0 typ op)) - + (add-method (local-method0 (type operation-method-alist) typ op) (let ((pair (%assq op operation-method-alist))) (if meth (cdr meth) nil))) - + (add-method ((setter local-method) (operation) op typ new-method) (set! (local-method0 typ op) new-method)) - + (add-method ((setter local-method0) (type operation-method-alist) typ op new-method) (cond ((null? new-method) --- oaklisp-1.3.3.orig/src/world/freeze.oak +++ oaklisp-1.3.3/src/world/freeze.oak @@ -19,10 +19,10 @@ ;; The locale structure looks like this: ;; -;; SYSTEM -;; / \ +;; SYSTEM +;; / \ ;; COMPILER SYSTEM-INTERNALS -;; / \ +;; / \ ;; SCRATCH COMPILER-INTERNALS ;; --- oaklisp-1.3.3.orig/src/world/read-token.oak +++ oaklisp-1.3.3/src/world/read-token.oak @@ -133,7 +133,7 @@ ((or (eq? c-syntax 'whitespace) (eq? (car c-syntax) 'terminating-macro)) (intern-it c r-charlist escaped?)) - (else + (else (signal bad-syntax-table-entry c c-syntax))))) ) ( (read-escaped c r-charlist) --- oaklisp-1.3.3.orig/src/world/cmdline.oak +++ oaklisp-1.3.3/src/world/cmdline.oak @@ -37,6 +37,6 @@ (define argline '()) (define (fetch-argline) - (set! argline (get-argline))) + (set! argline (get-argline))) (add-warm-boot-action fetch-argline) --- oaklisp-1.3.3.orig/src/world/tool.oak +++ oaklisp-1.3.3/src/world/tool.oak @@ -26,14 +26,14 @@ ; the input to this program is a bunch of files, each of which ; contains a big list whose format is -; +; ; (( ; ((constant 14 ((foo bar) baz)) -; (variable 2 append) ; these offsets are +; (variable 2 append) ; these offsets are ; (code 28 6)) ; in terms of 16 shortwords ; (100 343 232 ... ) ; 16 bit opcodes ; ) -; ( +; ( ; another code block ; ) ; ) @@ -60,7 +60,7 @@ (define value-stack-size #x1abc) (define context-stack-size #x2abc) -(set! world-array-size 0) +(set! world-array-size 0) (define cache-pairs? #t) @@ -98,7 +98,7 @@ (set! (nth world word-addr) word) (error "Attempt to overwrite <~s ~s>." word word-addr)))) -(define (store-world-opcodes o1 o2 word-addr) +(define (store-world-opcodes o1 o2 word-addr) (store-world-word (cons o1 o2) word-addr)) ;;; End of what used to be macros for speed @@ -112,7 +112,7 @@ (set! var-table #f) ;impose an ordering on variables -(set! var-list #f) +(set! var-list #f) (set! blk-table #f) (set! sym-table #f) (set! pair-table #f) @@ -223,7 +223,7 @@ (set! dat-count (+ dat-count (handbuilt-data-size))) (format #t "~&ops:~s vars:~s syms:~s cells:~s~%" opc-count var-count sym-count dat-count)) - + (define (count-opcodes blk) @@ -377,7 +377,7 @@ (define (spew-opcodes inlist in-names) (format #t " spew") (store-world-ptr where-%code-vector-lives start-of-opc-space) - (store-world-int first-regular-blk-addr (+ 1 start-of-opc-space)) + (store-world-int first-regular-blk-addr (+ 1 start-of-opc-space)) (store-world-ptr where-nil-lives (+ 2 start-of-opc-space)) (do ((fils inlist (cdr fils)) (filno 0 (+ filno 1)) @@ -425,7 +425,7 @@ ;this is a hack to string the top-level blocks together -(define (changereturntonoop addr) +(define (changereturntonoop addr) (let* ((them (get-world-opcodes addr)) (op1 (car them)) (op2 (cdr them))) @@ -580,7 +580,7 @@ - + @@ -678,14 +678,14 @@ (error "Can't PRINT-HEX #x~X with ~D digits" num ndigits))) (print num outfile)) - + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;test stuff ; -(define testlist - '( +(define testlist + '( ( ; start of file 1 ( ; start of block ((constant 6 ((foo bar) 1)) @@ -730,10 +730,10 @@ (dotimes (i array-size) (set! (nth world i) 0)))) -(define (overwrite-world-opcodes o1 o2 word-addr) +(define (overwrite-world-opcodes o1 o2 word-addr) (set! (nth world word-addr) (cons o1 o2))) -(define (overwrite-world-word word word-addr) +(define (overwrite-world-word word word-addr) (set! (nth world word-addr) word)) (define (get-world-word word-addr) --- oaklisp-1.3.3.orig/src/world/promise.oak +++ oaklisp-1.3.3/src/world/promise.oak @@ -58,7 +58,7 @@ ((eq? f '#f) (format s "#" self)) ((eq? f 'indicate) (format s "#[DELAY ~S ~!]" (force self) self)) (else (error "Unknow FORCIBLE-PRINT-MAGIC option ~S." f))))) - + (add-method (print-list-end (forcible) self . args) (if #*forcible-print-magic --- oaklisp-1.3.3.orig/src/world/list.oak +++ oaklisp-1.3.3/src/world/list.oak @@ -22,7 +22,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; handy list utilities ;;; +;;; handy list utilities ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -68,7 +68,7 @@ -; listify-args now gets the arguments +; listify-args now gets the arguments ; off the stack more cheaply than this older code ; ((list-aux-gen listsofar guy . rest) ; (if (zero? (rest-length rest)) --- oaklisp-1.3.3.orig/src/world/multiproc.oak +++ oaklisp-1.3.3/src/world/multiproc.oak @@ -75,7 +75,7 @@ (when trace-processes (format #t "init: oak process descriptor~%")) (set! pid 0) - (set! process-fluid-binding-list + (set! process-fluid-binding-list (map (lambda (z) (cons (car z) (cdr z))) fluid-binding-list)) self) @@ -167,7 +167,7 @@ (%store-process (make process)) (add-method (initialize (process pid process-fluid-binding-list) self) (set! pid (new-pid)) - (set! process-fluid-binding-list + (set! process-fluid-binding-list (copy-fluid-bindings (current-process))) self) (spawn-heavyweight-threads)) --- oaklisp-1.3.3.orig/src/world/assembler.oak +++ oaklisp-1.3.3/src/world/assembler.oak @@ -23,7 +23,7 @@ ;;; where byte-code-list is a list of bytecodes. ;;; Output format: a list of code segments, where each code segment is -;;; a list of two things: a resolution list and a list of numbers. The +;;; a list of two things: a resolution list and a list of numbers. The ;;; Some bytecodes refer ;;; to constants, such as symbols and lists. Such references are @@ -526,7 +526,7 @@ ;;; Bitwise operations are translated into LOG-OPs with the ;;; appropriate bitfields. Fill in the following truth table, and ;;; then construct a bitfield with the bits you get, as below. -;;; +;;; ;;; X ;;; 0 1 ;;; ------- --- oaklisp-1.3.3.orig/src/world/files.oak +++ oaklisp-1.3.3/src/world/files.oak @@ -185,13 +185,13 @@ '( crunch mac-comp-stuff - mac-compiler-nodes - mac-compiler1 - mac-compiler2 - mac-compiler3 - mac-code + mac-compiler-nodes + mac-compiler1 + mac-compiler2 + mac-compiler3 + mac-code assembler - peephole + peephole file-compiler compiler-exports )) --- oaklisp-1.3.3.orig/src/world/strings.oak +++ oaklisp-1.3.3/src/world/strings.oak @@ -188,8 +188,8 @@ -; Note: the following 3 macros exist ONLY to -; improve the readability of the following procedure. +; Note: the following 3 macros exist ONLY to +; improve the readability of the following procedure. ; They use %load-bp-i, and hence will break in other contexts. @@ -238,7 +238,7 @@ (add-method (#^list-type (string char-count) instring) (quick-vref-helper instring char-count))) - + @@ -292,7 +292,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; String predicates -;;; +;;; (add-method (= (string) x y) (equal? x y)) --- oaklisp-1.3.3.orig/src/world/macros1.oak +++ oaklisp-1.3.3/src/world/macros1.oak @@ -45,7 +45,7 @@ ; When compiling a file (using compile-file or load-oak-file), ; macro expansion occurs in a sub-locale that is augmented with -; the local syntax of that file, and so ^Vcurrent-locale is temporarily +; the local syntax of that file, and so ^Vcurrent-locale is temporarily ; rebound to the sub-locale. It is bound to the actual current locale ; during the load phase. ; @@ -134,7 +134,7 @@ ;;; DOTIMES, just like in Common Lisp -(define-syntax (dotimes (var limit . exit-body) . body) +(define-syntax (dotimes (var limit . exit-body) . body) (let ((exit-form (and exit-body (destructure* (a) exit-body a))) (v-limit (genvar)) (v-label (genvar))) @@ -160,7 +160,7 @@ (cond (,test ,@exit-body) (else ,@body (,aux ,@(map caddr clauses))))))) -(define-syntax (when test . body) +(define-syntax (when test . body) `(if ,test (block ,@body) when-undefined-value)) @@ -198,7 +198,7 @@ (let ((tv (genvar)) (lab (genvar))) `(iterate ,lab ((,v ,expr)) (let ((,tv (get-type ,v))) - (cond + (cond ,@(map (lambda (clause) (destructure* (types . body) clause `((or ,@(map (lambda (ty) @@ -216,7 +216,7 @@ (destructure* ('otherwise . body) otherwise-clause `((else ,@body))) '()))))))) - + (labels (((aux2 v expr) (if (null? clauses) (aux clauses #f v expr) --- oaklisp-1.3.3.orig/src/world/bignum.oak +++ oaklisp-1.3.3/src/world/bignum.oak @@ -246,7 +246,7 @@ (labels (((step-both in1 in2 carry prevpair) (if (null? in1) - (if (null? in2) + (if (null? in2) (block ;both empty (when (not (= 0 carry)) @@ -258,7 +258,7 @@ (quotient x bignum-base) (set! (cdr prevpair) (cons (remainder x bignum-base) '()))))) - (if (null? in2) + (if (null? in2) ;in2 empty (let ((x (fx-plus carry (car in1)))) (step-one (cdr in1) @@ -274,7 +274,7 @@ ((step-one in1 carry prevpair) - (cond ((null? in1) ;done + (cond ((null? in1) ;done (when (not (= 0 carry)) (set (cdr prevpair) (list carry))) (cdr root)) @@ -307,7 +307,7 @@ (if (null? in2) - (if (null? in1) + (if (null? in1) ;both empty (if (not (= 0 carry)) (error "negative result in diff-digitlist") @@ -418,7 +418,7 @@ accleft)) d/b)) acc) - + (let ((d (fx-plus (fx-plus carry (car accleft)) (fx-times (car listleft) dig)))) (set! (car accleft) (remainder d bignum-base)) @@ -449,17 +449,17 @@ ;;regular case (let* ((u (multiply-digitlists (sum-digitlists a b) (sum-digitlists c d))) (v (multiply-digitlists a c))) - (shift-sum-digitlists + (shift-sum-digitlists (shift-sum-digitlists v (diff-digitlists u (sum-digitlists v w)) lenx/2) w lenx/2)) - + ;;simplified case where c=0. - (shift-sum-digitlists + (shift-sum-digitlists (diff-digitlists (multiply-digitlists (sum-digitlists a b) d) w) w lenx/2))))))) - + (if (> leny lenx) (guts y x leny lenx) (guts x y lenx leny)))))) @@ -506,12 +506,12 @@ ; this is used by times/2 and quorem-digitlists-to-get-digit. (define (simple-multiply-step dig l) - (if (= 0 dig) + (if (= 0 dig) '() (let ((root (cons 'root '()))) (labels (((step-one in1 carry prevpair) - (cond ((null? in1) ;done + (cond ((null? in1) ;done (when (not (= 0 carry)) (set (cdr prevpair) (list carry))) (cdr root)) @@ -529,7 +529,7 @@ ;;;;;;;;;;;;;;;division;;;;;;;;;;;;;;;;;;;; -; Warning; this code assumes that two +; Warning; this code assumes that two ; bignum digits fit into a fixnum. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -555,7 +555,7 @@ (let ((lenin (length inlist)) (lendiv (length divisor))) - (if (if (= lenin lendiv) ;this expression is (digitlist-< inlist divisor) + (if (if (= lenin lendiv) ;this expression is (digitlist-< inlist divisor) (samelen-digitlist-< inlist divisor) (< lenin lendiv)) @@ -602,7 +602,7 @@ - ; Call the following helper function only when you are sure + ; Call the following helper function only when you are sure ; that the quotient can be expressed by a single digit. ; all arguments are digit lists @@ -610,9 +610,9 @@ (let ((last-short-divisor #t) ;cache some internal info - (fix-divisor #t) + (fix-divisor #t) (last-long-divisor #t) - (rev-divisor #t)) + (rev-divisor #t)) (define (quorem-digitlists-to-get-digit inlist divisor) @@ -673,7 +673,7 @@ (quotient (fx-plus (fx-times 100000 inlist-hi) (fx-plus (fx-times 10 (cadr rev-inlist)) (quotient (caddr rev-inlist) 1000))) - (if (= lenin lendiv) + (if (= lenin lendiv) (fx-plus (fx-times 100000 divisor-hi) (fx-plus (fx-times 10 (cadr rev-divisor)) (quotient (caddr rev-divisor) 1000))) @@ -684,7 +684,7 @@ (quotient (fx-plus (fx-times 1000000 inlist-hi) (fx-plus (fx-times 100 (cadr rev-inlist)) (quotient (caddr rev-inlist) 100))) - (if (= lenin lendiv) + (if (= lenin lendiv) (fx-plus (fx-times 1000000 divisor-hi) (fx-plus (fx-times 100 (cadr rev-divisor)) (quotient (caddr rev-divisor) 100))) @@ -694,7 +694,7 @@ (quotient (fx-plus (fx-times 10000000 inlist-hi) (fx-plus (fx-times 1000 (cadr rev-inlist)) (quotient (caddr rev-inlist) 10))) - (if (= lenin lendiv) + (if (= lenin lendiv) (fx-plus (fx-times 10000000 divisor-hi) (fx-plus (fx-times 1000 (cadr rev-divisor)) (quotient (caddr rev-divisor) 10))) @@ -788,7 +788,7 @@ (define least-positive-bignum (make bignum 1 l2)) (define least-negative-bignum (make bignum -1 l3))) - + #| @@ -806,13 +806,13 @@ (,labsym (1+ ,quotient-name)(- ,remainder-name ,divisor))))))) - + (define (sum-digitlists l1 l2) (let ((root (cons 'root '()))) (labels (((step-both in1 in2 carry prevpair) (if (null? in1) - (if (null? in2) + (if (null? in2) (block ;both empty (when (not (= 0 carry)) @@ -824,7 +824,7 @@ quo (set! (cdr prevpair) (cons rem '()))))) - (if (null? in2) + (if (null? in2) ;in2 empty (iterative-positive-quorem ((+ carry (car in1)) bignum-base quo rem) (step-one (cdr in1) @@ -839,7 +839,7 @@ (set! (cdr prevpair) (cons rem '()))))))) ((step-one in1 carry prevpair) - (cond ((null? in1) ;done + (cond ((null? in1) ;done (when (not (= 0 carry)) (set (cdr prevpair) (list carry))) (cdr root)) --- oaklisp-1.3.3.orig/src/world/compile-bench.oak +++ oaklisp-1.3.3/src/world/compile-bench.oak @@ -71,7 +71,7 @@ (y (make-locative x))) (format #t "Warning: installing ~S in ~A.~%" what locale) (set! (variable? locale what) y) - y))) + y))) (aux (cdr resolution-list) code-number-to-locs-alist)) ((or (eq? which 'code)(eq? which 1)) (aux (cdr resolution-list) --- oaklisp-1.3.3.orig/src/world/backquote.oak +++ oaklisp-1.3.3/src/world/backquote.oak @@ -22,7 +22,7 @@ ;;; Copyright (C) 1988 Barak A. Pearlmutter and Kevin J. Lang ;;; Oaklisp Mods: -;;; +;;; ;;; More-than-two arg append clause removed ;;; Appropriate (macro? system-locale X). @@ -112,7 +112,7 @@ (else ;; (CONS FOO 'BAR) => (list* FOO 'BAR) (LIST 'list* A D))))) - ((AND (PAIR? D) (MEMQ (CAR D) '(LIST list*))) + ((AND (PAIR? D) (MEMQ (CAR D) '(LIST list*))) ;; (CONS FOO (LIST . BAR)) => (LIST FOO . BAR) (list* (CAR D) A (CDR D))) (else (LIST 'list* A D)))))))) --- oaklisp-1.3.3.orig/src/world/export.oak +++ oaklisp-1.3.3/src/world/export.oak @@ -22,7 +22,7 @@ (if try (set! (variable-here? destination variable) try) (warning "~S not found in ~S; can't export.~%" variable source)))) - + --- oaklisp-1.3.3.orig/src/world/anonymous.oak +++ oaklisp-1.3.3/src/world/anonymous.oak @@ -123,8 +123,8 @@ (%get-an-ivar operation op 'lambda?) (any? (lambda (t) (got-a-method? t op)) supertype-list))) - - + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; --- oaklisp-1.3.3.orig/src/world/numbers.oak +++ oaklisp-1.3.3/src/world/numbers.oak @@ -367,7 +367,7 @@ (define-constant ash-right (add-method ((make-fancy-open-coded-operation (list foldable-mixin - backwards-args-mixin) + backwards-args-mixin) '((negate)(swap 1)(ash)) 2 1) (fixnum) x y) (ash-left x (- y)))) @@ -476,12 +476,12 @@ ; recoded below to allow multiple arguments -; +; ; (define-constant-instance max ; (mix-types oc-mixer (list foldable-mixin operation))) ; (define-constant-instance min ; (mix-types oc-mixer (list foldable-mixin operation))) -; +; ; (add-method (max (object) x y) ; (if (> x y) x y)) ; (add-method (min (object) x y) @@ -499,7 +499,7 @@ `(let* ((,var2 ,clause2) (,var1 ,clause1)) (if (> ,var2 ,var1) ,var2 ,var1)))) - + (local-syntax (max-macro . clauses) (let ((n-clauses (length clauses))) @@ -517,8 +517,8 @@ `(let* ((,var2 ,clause2) (,var1 ,clause1)) (if (< ,var2 ,var1) ,var2 ,var1)))) - - + + (local-syntax (min-macro . clauses) (let ((n-clauses (length clauses))) (cond ((zero? n-clauses) --- oaklisp-1.3.3.orig/src/world/file-compiler.oak +++ oaklisp-1.3.3/src/world/file-compiler.oak @@ -36,7 +36,7 @@ (set! compiler-to-extension ".oa") ;;; valid values: 0, 1 or 2. -(define #*compiler-noisiness 1) +(define #*compiler-noisiness 1) (set! #*compiling-a-file? #f) --- oaklisp-1.3.3.orig/src/world/hash-table.oak +++ oaklisp-1.3.3/src/world/hash-table.oak @@ -210,7 +210,7 @@ (let ((l (length x))) ;; First clause is not portable--relies on uniqueness of the empty vector. (cond ((zero? l) (object-hash x)) - (else (bit-xor + (else (bit-xor (bit-xor (rot-left l 23) (rot-left (tree-hash-aux (nth x 0) (+ d 1)) 17)) (bit-xor (rot-left (tree-hash-aux (nth x (modulo 7 l)) (+ d 1)) 11) --- oaklisp-1.3.3.orig/src/world/subprimitive.oak +++ oaklisp-1.3.3/src/world/subprimitive.oak @@ -177,7 +177,7 @@ (set! (locater %load-bp-i) (make (mix-types oc-mixer (list open-coded-mixin operation)) '((locate-bp-i)) 1 1)) - + --- oaklisp-1.3.3.orig/src/world/reader-errors.oak +++ oaklisp-1.3.3/src/world/reader-errors.oak @@ -65,7 +65,7 @@ (add-method (initialize (list-end-error list-so-far stuff-after-dot) self the-lsf the-sad) (set! list-so-far the-lsf) - (set! stuff-after-dot the-sad) + (set! stuff-after-dot the-sad) self) (add-method (report (list-end-error list-so-far stuff-after-dot) self stream) --- oaklisp-1.3.3.orig/src/world/kernel1-maketype.oak +++ oaklisp-1.3.3/src/world/kernel1-maketype.oak @@ -26,7 +26,7 @@ (set! variable-length? nil) (set! supertype-list the-supertype-list) (set! ivar-list the-ivar-list) - (set! ivar-count (%length ivar-list)) + (set! ivar-count (%length ivar-list)) (set! operation-method-alist '()) (set! top-wired? nil) ;; Got to compute type-bp-alist and instance-length together: --- oaklisp-1.3.3.orig/src/world/mac-code.oak +++ oaklisp-1.3.3/src/world/mac-code.oak @@ -20,7 +20,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; handy list utilities ;;; +;;; handy list utilities ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (swap-car-with-nth inlist n) @@ -31,7 +31,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; generate code to copy args down before tail calls ;;; +;;; generate code to copy args down before tail calls ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -45,13 +45,13 @@ (reverse (append (map (lambda (d) 'd) (iota old)) (iota new)))) - + ((count-trash-on-top x) ; sends (d d 3 2 1 d) to (2 3 2 1 d) (iterate step ((count 0)(l x)) (if (or (null? l) (number? (car l))) (cons count l) (step (+ 1 count) (cdr l))))) - + ((plan-blt old new) (iterate step ((plan '())(model (build-model old new))) (cond ((= (length model) new) @@ -68,7 +68,7 @@ (let ((counted (count-trash-on-top model))) (step (cons `(pop ,(car counted)) plan) (cdr counted)))))))) - + (define (blt-stack n m) (cond ((zero? m) '()) @@ -83,7 +83,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; primitive continuation definition ;;; +;;; primitive continuation definition ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -109,13 +109,13 @@ (not (eq? self #*barrier-node))) (number-of-args-to-pop (node-enclosing-contour self)) 0))) - + (add-method (number-of-args-to-pop (ast-labels-node) self) (if (and (contn-transparent? self) (not (eq? self #*barrier-node))) (number-of-args-to-pop (node-enclosing-contour self)) 0)) - + (add-method (nguys-to-pop (ast-node enclosing-contour) self) (number-of-args-to-pop enclosing-contour)) @@ -163,26 +163,26 @@ (add-method (gen-access-code (ast-variable-node var-type name source-contour) self cont store?) - (append + (append (cond ((eq? var-type 'stack) `((,(if store? 'store-stk 'load-stk) ,(compute-offset self (node-stack-map self)) ,name))) - + ((eq? var-type 'evar) `((,(if store? 'store-env 'load-env) ;; Note the extra offset of 2 here: ,(+ 2 (compute-offset self (contn-envlist source-contour))) ,name))) - + ((eq? var-type 'ivar) `((,(if store? 'store-bp 'load-bp) ,(compute-offset self (methn-ivarmap source-contour)) ,name))) - + ((eq? var-type 'global) `((load-glo ,name))) - + (else (error "gen-access: Error in var-type for ~S" (list var-type name)))) (primitive-continuation self cont))) @@ -194,8 +194,8 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; The gen-code operation takes two arguments, an ast node and a continuation, -; which may be one of three things: the symbol TAIL, the symbol NEXT, -; or a label, which can be any other symbol. +; which may be one of three things: the symbol TAIL, the symbol NEXT, +; or a label, which can be any other symbol. (define-instance top-level-gen-code operation) @@ -216,7 +216,7 @@ ;Definitions for the primitive forms (with-operations (nargs-prologue) - + (add-method (nargs-prologue (ast-method-node arglist rest-name) self) (if rest-name (let ((real-nargs (length (cdr arglist)))) @@ -229,7 +229,7 @@ `(load-reg nargs) `(subtract)))) (list `(check-nargs ,(length arglist))))) - + (add-method (gen-code (ast-method-node ivarmap status body arglist) self cont) (cond ((eq? status 'code) (append @@ -279,7 +279,7 @@ (let ((gen-makloc-code (make operation))) - + (add-method (gen-makloc-code (ast-variable-node var-type name source-contour) self cont) (append (cond ((memq var-type '(stack evar global)) @@ -290,8 +290,8 @@ `(make-bp-loc ,(compute-offset self (methn-ivarmap source-contour)) ,name))) (else (error "Makloc: Error in var-type for ~S" (list var-type name)))) (primitive-continuation self cont))) - - + + (add-method (gen-code (ast-make-locative-node variable) self cont) (gen-makloc-code variable cont))) @@ -373,7 +373,7 @@ (with-operations (open-code label-code inline-code regular-code combo-op get-jump-info) - + (add-method (combo-op (ast-combination-node op rest-name) self) (cond ((not (eq? rest-name nichevo)) regular-code) @@ -391,20 +391,20 @@ (methn-status op))) (else regular-code))) - - + + (add-method (gen-code (ast-combination-node) self cont) ((combo-op self) self cont)) - - + + (add-method (get-jump-info (ast-labels-node labellist lambdalist gensymlist) self name) (let* ((the-lambda (rib-lookup labellist lambdalist name)) (the-target (rib-lookup labellist gensymlist name)) (nargs-required (length (methn-arglist the-lambda)))) - (cons the-target nargs-required))) - - + (cons the-target nargs-required))) + + (add-method (label-code (ast-combination-node op args) self cont) (let* ((name (varn-name op)) (source-contour (varn-source-contour op)) @@ -420,8 +420,8 @@ (branch ,the-target)) (error "CodeGen: Wrong number of arguments to operation ~S" name)) (error "Compiler error: branch to ~S not tail recursive" the-target)))) - - + + (add-method (open-code (ast-combination-node op args) self cont) (let* ((n-args (length args)) (opval (constn-value op)) @@ -443,7 +443,7 @@ (else `((branch ,cont))))) (error "CodeGen: Wrong number of arguments to operation ~S" opval)))) - + (add-method (inline-code (ast-combination-node op args) self cont) (let ((label? (not (memq cont '(next tail))))) (if (= (length args) (length (methn-arglist op))) @@ -456,7 +456,7 @@ - + (add-method (regular-code (ast-combination-node op args rest-name) self cont) (let* ((nmyargs (length args)) (totalmyargs (+ 1 nmyargs))) @@ -472,7 +472,7 @@ '() (list `(load-imm ,nmyargs) '(plus))) - (list + (list `(store-reg nargs) `(pop 1))))) (if (eq? cont 'tail) (pop-args self totalmyargs) --- oaklisp-1.3.3.orig/src/world/mac-compiler-nodes.oak +++ oaklisp-1.3.3/src/world/mac-compiler-nodes.oak @@ -28,7 +28,7 @@ (define-instance ast-constant-node type '(value name ;name is for documentation purposes - origin) ;origin holds folded node + origin) ;origin holds folded node (list ast-node)) (define-instance ast-if-node type @@ -43,8 +43,8 @@ type '(localvars ;names added in this contour nojumplist ;localvars that are referenced except in car position closedlist ;localvars that are closed over - environment ;lexically apparent external variables - envlist) ;external variables that are closed over + environment ;lexically apparent external variables + envlist) ;external variables that are closed over (list ast-node)) (define-instance ast-method-node --- oaklisp-1.3.3.orig/src/world/interpreter.oak +++ oaklisp-1.3.3/src/world/interpreter.oak @@ -47,7 +47,7 @@ -(labels (((partially-reverse-4 inlist) +(labels (((partially-reverse-4 inlist) (labels (((loop3 old new) (if (null? old) new --- oaklisp-1.3.3.orig/src/world/kernel0types.oak +++ oaklisp-1.3.3/src/world/kernel0types.oak @@ -18,7 +18,7 @@ ;;; Copyright (C) 1986 Barak A. Pearlmutter & Kevin J. Lang ;;; This program defines some types in a crude way so that -;;; we can send messages to everything. +;;; we can send messages to everything. ;;; Most of these these types must be adjusted later in the boot ;;; process so that their inheritance relationships will be correct. --- oaklisp-1.3.3.orig/src/world/consume.oak +++ oaklisp-1.3.3/src/world/consume.oak @@ -62,7 +62,7 @@ (let ((new-last-pair (cons h '()))) - (set! (cdr prev-pair) + (set! (cdr prev-pair) (cons a (cons b (cons c (cons d (cons e (cons f (cons g new-last-pair)))))))) @@ -116,7 +116,7 @@ ) - + --- oaklisp-1.3.3.orig/src/world/mac-comp-stuff.oak +++ oaklisp-1.3.3/src/world/mac-comp-stuff.oak @@ -36,7 +36,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - + (define (subset? x y) (null? (setdifference x y))) @@ -73,7 +73,7 @@ (define-constant _%install-method-with-env - (make-open-coded-operation + (make-open-coded-operation (lambda (n) (if (not (= n 4)) (error "_%install-method-with-env takes 4 args, not ~A." n) --- oaklisp-1.3.3.orig/src/misc/unit-testing.oak +++ oaklisp-1.3.3/src/misc/unit-testing.oak @@ -162,7 +162,7 @@ ))) (define-syntax (add-eq-test unit expect form . message) - `(add-test ,unit ,expect ,form eq? . ,message)) + `(add-test ,unit ,expect ,form eq? . ,message)) (define-syntax (add-equal-test unit expect form . message) `(add-test ,unit ,expect ,form equal? . ,message)) @@ -196,8 +196,8 @@ ;; If error or exception, break into debugger if BREAK-ON-ERROR-P, else continue (add-method (run-test ( expected thunk compare? message) self verbose-p break-on-error-p) - (let* ((caught-exception #f) - (actual + (let* ((caught-exception #f) + (actual (bind-error-handler (general-error ;; catch every type of error (lambda (err-obj) @@ -227,7 +227,7 @@ self unit) (let ((unit-tests (tests-for self unit))) (if unit-tests - (for-each + (for-each (lambda (test) (run-test test verbose-p break-on-error-p)) (reverse unit-tests)) ((if break-on-error-p error warning) @@ -239,7 +239,7 @@ (if tests (block (format #t "~&===>Starting Tests for ~a" unit) - (for-each + (for-each (lambda (test) (run-test test verbose-p break-on-error-p)) (reverse tests)) (format #t "~&===> Completed Tests for ~a~&" unit) @@ -258,7 +258,7 @@ (unless (subtype? (get-type self)) (error "EXCEPTION TEST INVOKED ON NON-EXECEPTION: ~a" self)) (let* ((caught-exception #f) - (actual + (actual (bind-error-handler (general-error ;; catch every type of error (lambda (err-obj) --- oaklisp-1.3.3.orig/doc/Makefile +++ oaklisp-1.3.3/doc/Makefile @@ -27,7 +27,7 @@ .PHONY: install install: - $(MAKE) -C lang lang.ps - $(MAKE) -C lim lim.ps + $(MAKE) -C lang lang.pdf + $(MAKE) -C lim lim.pdf mkdir --parents $d - cp -a lang/lang.ps lim/lim.ps $d/ + cp -a lang/lang.pdf lim/lim.pdf $d/ --- oaklisp-1.3.3.orig/doc/oakman.bib +++ oaklisp-1.3.3/doc/oakman.bib @@ -1,4 +1,4 @@ -@article ( OAKLANG88 , +@article ( OAKLANG88, author = "Kevin J. Lang and Barak A. Pearlmutter", title = "{O}aklisp: an Object-Oriented Dialect of {S}cheme", publisher = "Kluwer Academic Publishers", @@ -91,7 +91,8 @@ author = "Kevin J. Lang and Barak A. Pearlmutter", title = "{O}aklisp: an Object-Oriented {S}cheme with First Class Types", -pages = "30--37" +pages = "30--37", +doi = "10.1145/960112.28701", ) @techreport ( 3LISP, @@ -265,7 +266,8 @@ Languages and Applications", month = sep, year = 1986, -note = "Special issue of {\em SIGPLAN Notices}" +issn = "0362-1340", +note = "Special issue of {\em ACM SIGPLAN Notices} 21(11)" ) @book (TALI91, @@ -281,13 +283,12 @@ title = "The {CMU} Implementation of {O}aklisp", howpublished = "Released under the GPL, available via ftp", year = 1986, - note = "Most recent release: 1992, version 1.2. - Accompanied by extensive language and implementation - manuals. Under reasonably widespread use. Ports - exist for Unix (most versions), AmigaDOS, MacOS, - MS-DOS, Microsoft Windows, OS/2, CrayOS, and - others. - Influenced Apple's Dylan effort.", + note = "Most recent release: 1992, version 1.2. Accompanied + by extensive language and implementation manuals. + Ports were made for Unix (most versions), AmigaDOS, + MacOS, MS-DOS, Microsoft Windows, OS/2, CrayOS, and + others. Influenced Sun's Java and Apple's Dylan + efforts.", Xnote = "26,000 lines of code" } --- oaklisp-1.3.3.orig/doc/mandefs.tex +++ oaklisp-1.3.3/doc/mandefs.tex @@ -37,8 +37,8 @@ \newcommand{\header}[2]{\par\noindent\hspace{\leftmargini }{#1}\hfill\emph{#2}\hspace*{\leftmargini}\newline} -\newcommand{\heady}[3]{\index{{\tt#1} ! #3}\header{{\tt#1 \emph{#2}}}{#3}} -\newcommand{\headyy}[3]{\index{{\tt#1} ! #3}\header{{\tt(#1 \emph{#2}\tt)}}{#3}} +\newcommand{\heady}[3]{\index{{\tt#1} ! #3}\header{{\tt#1\ \emph{#2}}}{#3}} +\newcommand{\headyy}[3]{\index{{\tt#1} ! #3}\header{{\tt(#1\ \emph{#2}\tt)}}{#3}} \newcommand{\sform}[2]{\headyy{#1}{#2}{Special Form}} \newcommand{\op}[2]{\headyy{#1}{#2}{Operation}} @@ -70,7 +70,7 @@ \newcommand{\meq}{$\equiv$} \newcommand{\upar}{$\uparrow$} -\newcommand{\dt}{{\tt~.~}} +\newcommand{\dt}{{\tt{.}~}} \newcommand{\lpar}{{\tt(}} \newcommand{\rpar}{{\tt)}} --- oaklisp-1.3.3.orig/doc/examples/unit-testing.oak +++ oaklisp-1.3.3/doc/examples/unit-testing.oak @@ -147,7 +147,7 @@ ) ;;;====================================================================== -;;;A is an UNnamed container of unit tests, setup and +;;;A is an UNnamed container of unit tests, setup and ;;; teardown code. Tests are a reversed list of ;;; instances (see below). A instance maintains the (name X ;;; unit-test-suite) bindings. @@ -189,7 +189,7 @@ (block (setup-thunk) (format #t "~%===> Starting Tests for ~a" test-name) - (for-each + (for-each (lambda (test) (run-test test result-counter verbose-p break-on-error-p)) (reverse test-list)) (format #t "~&===> Completed Tests for ~a~%" test-name) @@ -302,7 +302,7 @@ ) ) ) (define-syntax (add-eq-test unit-name expect form . message) - `(add-test ,unit-name ,expect ,form eq? . ,message)) + `(add-test ,unit-name ,expect ,form eq? . ,message)) (define-syntax (add-equal-test unit-name expect form . message) `(add-test ,unit-name ,expect ,form equal? . ,message)) @@ -340,8 +340,8 @@ ;; Result-counter is-a (add-method (run-test ( expected thunk compare? message) self result-counter verbose-p break-on-error-p) - (let* ( (caught-exception #f) - (actual + (let* ( (caught-exception #f) + (actual (bind-error-handler (general-error ;; catch every type of error (lambda (err-obj) @@ -406,7 +406,7 @@ (add-method (%run-exception-test ( expected thunk compare? message) self result-counter verbose-p break-on-error-p) (let* ( (caught-exception #f) - (actual + (actual (bind-error-handler (general-error ;; catch every type of error (lambda (err-obj) --- oaklisp-1.3.3.orig/doc/examples/test-bank-example.oak +++ oaklisp-1.3.3/doc/examples/test-bank-example.oak @@ -24,7 +24,7 @@ (make name-1 age-1 SSN-1 passwd-1)) (define history-1 (make 37)) (define bank-account-1 (make bank-passwd initial-balance name-1 age-1 SSN-1 passwd-1)) - + ) (define-constant (teardown-thunk) --- oaklisp-1.3.3.orig/doc/examples/bank-example.oak +++ oaklisp-1.3.3/doc/examples/bank-example.oak @@ -32,7 +32,7 @@ `(define-instance ,name settable-operation)) ;; @@DEBUG -;; (define trace-expansion #t) +;; (define trace-expansion #t) ;; Test 'em out @@ -182,6 +182,6 @@ (add-method (SSN () self passwd) (^super SSN self passwd)) - + ;; --- E O F --- ;; --- oaklisp-1.3.3.orig/doc/lang/Makefile +++ oaklisp-1.3.3/doc/lang/Makefile @@ -14,7 +14,7 @@ # or from the Free Software Foundation, 59 Temple Place - Suite 330, # Boston, MA 02111-1307, USA -all: lang.dvi +all: lang.pdf SRC = control.tex cover.tex dynamic.tex intro.tex io.tex lang.tex \ locales.tex methods.tex misc.tex numbers.tex sequences.tex \ @@ -24,17 +24,23 @@ lang.dvi: $(SRC) $(OSRC) ../mandefs.tex -rm lang.ind - -latex lang