Fixing formatting of files and removed tabs.

This commit is contained in:
Kevin Cozens 2011-09-04 16:46:13 -04:00
parent b61b8782d0
commit 599f6e8390
3 changed files with 120 additions and 41 deletions

View File

@ -210,7 +210,7 @@
(if (null? lists)
(cons cars cdrs)
(let ((car1 (caar lists))
(cdr1 (cdar lists)))
(cdr1 (cdar lists)))
(unzip1-with-cdr-iterative
(cdr lists)
(append cars (list car1))
@ -338,13 +338,14 @@
;;;;;Helper for the dynamic-wind definition. By Tom Breton (Tehom)
(define (shared-tail x y)
(let ( (len-x (length x))
(len-y (length y)))
(let ((len-x (length x))
(len-y (length y)))
(define (shared-tail-helper x y)
(if
(eq? x y)
x
(shared-tail-helper (cdr x) (cdr y))))
(cond
((> len-x len-y)
(shared-tail-helper
@ -393,16 +394,16 @@
;;Exit the old list. Do deeper ones last. Don't do
;;any shared ones.
(define (pop-many)
(unless (eq? *active-windings* shared)
(deactivate-top-winding!)
(pop-many)))
(unless (eq? *active-windings* shared)
(deactivate-top-winding!)
(pop-many)))
;;Enter the new list. Do deeper ones first so that the
;;deeper windings will already be active. Don't do any
;;shared ones.
(define (push-many new-ws)
(unless (eq? new-ws shared)
(push-many (cdr new-ws))
(activate-winding! (car new-ws))))
(unless (eq? new-ws shared)
(push-many (cdr new-ws))
(activate-winding! (car new-ws))))
;;Do it.
(pop-many)
@ -413,20 +414,20 @@
`(define call-with-current-continuation
;;It internally uses the built-in call/cc, so capture it.
,(let ((old-c/cc call-with-current-continuation))
(lambda (func)
;;Use old call/cc to get the continuation.
(old-c/cc
(lambda (continuation)
;;Call func with not the continuation itself
;;but a procedure that adjusts the active
;;windings to what they were when we made
;;this, and only then calls the
;;continuation.
(func
(let ((current-ws *active-windings*))
(lambda (x)
(set-active-windings! current-ws)
(continuation x)))))))))
(lambda (func)
;;Use old call/cc to get the continuation.
(old-c/cc
(lambda (continuation)
;;Call func with not the continuation itself
;;but a procedure that adjusts the active
;;windings to what they were when we made
;;this, and only then calls the
;;continuation.
(func
(let ((current-ws *active-windings*))
(lambda (x)
(set-active-windings! current-ws)
(continuation x)))))))))
outer-env)
;;We can't just say "define (dynamic-wind before thunk after)"
;;because the lambda it's defined to lives in this environment,
@ -434,13 +435,13 @@
(eval
`(define dynamic-wind
,(lambda (before thunk after)
;;Make a new winding
(activate-winding! (make-winding before after))
(let ((result (thunk)))
;;Get rid of the new winding.
(deactivate-top-winding!)
;;The return value is that of thunk.
result)))
;;Make a new winding
(activate-winding! (make-winding before after))
(let ((result (thunk)))
;;Get rid of the new winding.
(deactivate-top-winding!)
;;The return value is that of thunk.
result)))
outer-env)))
(define call/cc call-with-current-continuation)
@ -696,8 +697,9 @@
(foldr (lambda (x y) (or (cond-eval x) (cond-eval y))) #f cond-list))
(define (cond-eval condition)
(cond ((symbol? condition)
(if (member condition *features*) #t #f))
(cond
((symbol? condition)
(if (member condition *features*) #t #f))
((eq? condition #t) #t)
((eq? condition #f) #f)
(else (case (car condition)

View File

@ -1,5 +1,5 @@
Building TinyScheme
-------------------
Building TinyScheme
-------------------
The included makefile includes logic for Linux, Solaris and Win32, and can
readily serve as an example for other OSes, especially Unixes. There are
@ -11,8 +11,8 @@ Autoconfing TinyScheme was once proposed, but the distribution would not be
so small anymore. There are few platform dependencies in TinyScheme, and in
general compiles out of the box.
Customizing
-----------
Customizing
-----------
The following symbols are defined to default values in scheme.h.
Use the -D flag of cc to set to either 1 or 0.
@ -62,3 +62,78 @@ general compiles out of the box.
Shortcut to disable USE_MATH, USE_CHAR_CLASSIFIERS, USE_ASCII_NAMES,
USE_STRING_PORTS, USE_ERROR_HOOK, USE_TRACING, USE_COLON_HOOK,
USE_DL.
USE_SCHEME_STACK
Enables 'cons' stack (the alternative is a faster calling scheme, which
breaks continuations). Undefine it if you don't care about strict compatibility
but you do care about faster execution.
OS-X tip
--------
I don't have access to OS-X, but Brian Maher submitted the following tip:
[1] Download and install fink (I installed fink in
/usr/local/fink)
[2] Install the 'dlcompat' package using fink as such:
> fink install dlcompat
[3] Make the following changes to the
tinyscheme-1.32.tar.gz
diff -r tinyscheme-1.32/dynload.c
tinyscheme-1.32-new/dynload.c
24c24
< #define SUN_DL
---
>
Only in tinyscheme-1.32-new/: dynload.o
Only in tinyscheme-1.32-new/: libtinyscheme.a Only in tinyscheme-1.32-new/: libtinyscheme.so diff -r tinyscheme-1.32/makefile tinyscheme-1.32-new/makefile
33,34c33,43
< LD = gcc
< LDFLAGS = -shared
---
> #LD = gcc
> #LDFLAGS = -shared
> #DEBUG=-g -Wno-char-subscripts -O
> #SYS_LIBS= -ldl
> #PLATFORM_FEATURES= -DSUN_DL=1
>
> # Mac OS X
> CC = gcc
> CFLAGS = -I/usr/local/fink/include
> LD = gcc
> LDFLAGS = -L/usr/local/fink/lib
37c46
< PLATFORM_FEATURES= -DSUN_DL=1
---
> PLATFORM_FEATURES= -DSUN_DL=1 -DOSX
60c69
< $(CC) -I. -c $(DEBUG) $(FEATURES)
$(DL_FLAGS) $<
---
> $(CC) $(CFLAGS) -I. -c $(DEBUG)
$(FEATURES) $(DL_FLAGS) $<
66c75
< $(CC) -o $@ $(DEBUG) $(OBJS) $(SYS_LIBS)
---
> $(CC) $(LDFLAGS) -o $@ $(DEBUG) $(OBJS)
$(SYS_LIBS)
Only in tinyscheme-1.32-new/: scheme
diff -r tinyscheme-1.32/scheme.c
tinyscheme-1.32-new/scheme.c
60,61c60,61
< #ifndef macintosh
< # include <malloc.h>
---
> #ifdef OSX
> /* Do nothing */
62a63,65
> # ifndef macintosh
> # include <malloc.h>
> # else
77c80,81
< #endif /* macintosh */
---
> # endif /* macintosh */
> #endif /* !OSX */
Only in tinyscheme-1.32-new/: scheme.o

View File

@ -210,7 +210,7 @@
(if (null? lists)
(cons cars cdrs)
(let ((car1 (caar lists))
(cdr1 (cdar lists)))
(cdr1 (cdar lists)))
(unzip1-with-cdr-iterative
(cdr lists)
(append cars (list car1))
@ -338,13 +338,14 @@
;;;;;Helper for the dynamic-wind definition. By Tom Breton (Tehom)
(define (shared-tail x y)
(let ( (len-x (length x))
(len-y (length y)))
(let ((len-x (length x))
(len-y (length y)))
(define (shared-tail-helper x y)
(if
(eq? x y)
x
(shared-tail-helper (cdr x) (cdr y))))
(cond
((> len-x len-y)
(shared-tail-helper
@ -696,8 +697,9 @@
(foldr (lambda (x y) (or (cond-eval x) (cond-eval y))) #f cond-list))
(define (cond-eval condition)
(cond ((symbol? condition)
(if (member condition *features*) #t #f))
(cond
((symbol? condition)
(if (member condition *features*) #t #f))
((eq? condition #t) #t)
((eq? condition #f) #f)
(else (case (car condition)