|
s7 is a Scheme implementation, compatible with r5rs, and intended as an extension language for other applications, primarily Snd and Common Music. It exists as just two files, s7.c and s7.h, that want only to disappear into someone else's source tree. There are no libraries, no run-time init files, and no configuration scripts. It can be built as a stand-alone interpreter, if you insist (see below). s7test.scm is a regression test for s7. If you're running s7 in a context that has getenv, file-exists?, and system (Snd for example), you can use s7-slib-init.scm to gain easy access to slib (this init file is named "s7.init" in the slib distribution).
s7 is the default extension language of Snd and sndlib (http://ccrma.stanford.edu/software/snd/), and Rick Taube's Common Music (commonmusic at sourceforge). There are X, Motif, Gtk, and openGL bindings in libxm (in the Snd tarball, or at ftp://ccrma-ftp.stanford.edu/pub/Lisp/libxm.tar.gz).
s7 has full continuations, dynamic-wind, sort!, error handling, ratios and complex numbers, defmacro and define-macro, keywords, hash-tables, block comments, threads, multiprecision arithmetic for all numeric types, generalized set!, format, define*, and a host of other extensions of r5rs. It does not have syntax-rules or any of its friends, and it does not think there is any such thing as an "inexact integer" (what were those guys smoking?).
This file assumes you know about Scheme and all its problems, and want a quick tour of where s7 is different:
call-with-exit is call/cc without the ability to return (an escape or goto, "call/exit"?).
(define (find-first-even-number arg) (call-with-exit (lambda (return) (for-each (lambda (a) (if (even? a) (return a))) arg)))) (find-first-even-number (list 1 3 9 13 8 2 4)) -> 8
continuation? returns #t if its argument is a continuation, as opposed to a normal procedure.
All numeric types (integers, ratios, reals, complex numbers) are supported. The basic integer and real types are defined in s7.h, defaulting to long long int and double. pi is predefined, as are most-positive-fixnum and most-negative-fixnum. s7 can be built with multiprecision support for all types, using the gmp, mpfr, and mpc libraries (set WITH_GMP to 1 in s7.c). If multiprecision arithmetic is enabled, the following functions are included: bignum, bignum?, and bignum-precision. bignum-precision, which defaults to 128, sets the number of bits each float takes. pi automatically reflects the current bignum-precision:
> pi 3.141592653589793238462643383279502884195E0 > (bignum-precision) 128 > (set! (bignum-precision) 256) 256 > pi 3.141592653589793238462643383279502884197169399375105820974944592307816406286198E0
bignum? returns #t if its argument is a big number of some type (that is, I use "bignum" for any big number, not just integers). To create a big number, either include enough digits to overflow the default types, or use the bignum function. Its argument is a string representing the desired number:
> (bignum "123456789123456789") 123456789123456789 > (bignum "1.123123123123123123123123123") 1.12312312312312312312312312300000000009E0
s7 includes:
The random function can take any numeric argument, including 0 (don't get me started...). The following constants are predefined: pi, most-positive-fixnum, most-negative-fixnum. Other math-related differences between s7 and r5rs:
> (exact? 1.0) #f > (floor 1.4) 1 > (rational? 1.5) #f > (modulo 1.4 1.0) 0.4 > (lcm 3/4 1/6) 3/2 > (log 8 2) 3 > (number->string 0.5 2) "0.1" > (string->number "0.1" 2) 0.5 > (rationalize 1.5) 3/2
These are the standard macro definers.
(define-macro (add-1 arg) `(+ 1 ,arg)) (defmacro add-1 (arg) `(+ 1 ,arg))
macroexpand can help debug a macro:
> (define-macro (add-1 arg) `(+ 1 ,arg)) add-1 > (macroexpand (add-1 32)) (+ 1 32)
gensym returns a symbol that is guaranteed to be currently unused. It takes an optional string argument giving the new symbol name's prefix.
(defmacro pop! (sym) (let ((v (gensym))) `(let ((,v (car ,sym))) (set! ,sym (cdr ,sym)) ,v)))
These are extensions of define and lambda that make it easier to to deal with optional, keyword, and rest arguments. The syntax is very simple: every argument to define* has a default value and is automatically available as a keyword argument. The default value is either #f (if unspecified), or given in a list whose first member is the argument name. The last argument can be preceded by :rest or a dot to indicate that all other trailing arguments should be packaged as a list under that argument's name. You can use :optional and :key, but they are ignored.
(define* (hi a (b 32) (c "hi")) (list a b c))
Here the argument "a" defaults to #f, "b" to 32, etc. When the function is called, the argument names are bound to their default values, then the function's current argument list is scanned. Any name that occurs as a keyword (":a") sets that argument's new value. Otherwise, as values occur, they are plugged into the actual argument list based on their position. This is called an optional-key list in CLM. So, taking the function above as an example:
(hi 1) -> '(1 32 "hi") (hi :b 2 :a 3) -> '(3 2 "hi") (hi 3 2 1) -> '(3 2 1)
define-constant defines a constant and constant? returns #t if its argument is a constant. A constant in s7 is really constant: it can't be set or rebound.
> (define-constant var 32) var > (set! var 1) ;set!: can't alter immutable object: var > (let ((var 1)) var) ;can't bind or set an immutable object: var, line 1
This has the possibly surprising side effect that previous uses of the constant name become constants:
(define (func a) (let ((cvar (+ a 1))) cvar)) (define-constant cvar 23) (func 1) ;can't bind or set an immutable object: cvar
So, obviously, choose unique names for your constants, or don't use define-constant.
A procedure-with-setter consists of two functions, the "getter" and the "setter". The getter is called when the object is encountered as a function, and the setter when it is set:
(define x 32) (define xx (make-procedure-with-setter (lambda () x) (lambda (val) (set! x val) x))) (xx) -> 32 (set! (xx) 1) (xx) -> 1
Lists, strings, vectors, hash-tables, and any cooperating C-defined objects are both applicable and settable. I think the syntax is pretty:
(let ((lst (list 1 2 3))) (set! (lst 1) 32) (list (lst 0) (lst 1))) -> '(1 32) (let ((hash (make-hash-table))) (set! (hash 'hi) 32) (hash 'hi)) -> 32
You can use list-ref and friends, of course, but just try to read any serious vector arithmetic code when it is buried in vector-refs and vector-set!s!
Multi-line comments can be enclosed in either #| and |#, or #! and !# (the latter is for compatibility with Guile).
The hashed object can be a symbol, string, integer, or (problematically of course) a real.
If s7 is built with HAVE_PTHREADS set, you get multithreading functions.
Threads in s7 share the heap and symbol table, but have their own local environment, stack, and evaluator locals. I use the term "lock" in place of "mutex", and "thread-variable" in place of "pthread_key". The thread-variable is applicable and settable, so instead of pthread_getspecific, simply call it: (var).
s7's built-in format function is very close to that in srfi-48.
(format #f "~A ~D ~F" 'hi 123 3.14) -> "hi 123 3.140000"
object->string returns the string representation of its argument, like format with ~S:
> (object->string "hiho") "\"hiho\"" > (format #f "~S" "hiho") "\"hiho\""
s7 exists only to serve as an extension of some other application, so in a sense it is just a foreign function interface. See s7.h for the API and many examples. Here is a bare REPL:
#include <stdlib.h> #include <stdio.h> #include <string.h> #include "s7.h" static s7_pointer our_exit(s7_scheme *sc, s7_pointer args) {exit(1);} int main(int argc, char **argv) { s7_scheme *s7; char buffer[512]; char response[1024]; s7 = s7_init(); /* initialize the interpreter */ s7_define_function(s7, "exit", our_exit, 0, 0, false, "(exit) exits the program"); while (1) /* fire up a REPL */ { fprintf(stdout, "\n> "); /* prompt for input */ fgets(buffer, 512, stdin); if ((buffer[0] != '\n') || (strlen(buffer) > 1)) { sprintf(response, "(write %s)", buffer); s7_eval_c_string(s7, response); /* evaluate input and write the result */ } } }
s7's error handling mimics that of (pre-r6rs) Guile. An error is signalled via the error function, and can be trapped and dealt with via catch.
(catch 'wrong-number-of-args (lambda () ; code protected by the catch (abs 1 2)) (lambda args ; the error handler (apply format (append (list #t) (cadr args))))) -> "abs: too many arguments: (1 2)"
catch has 3 arguments: a tag indicating what error to catch (#t = anything), the code (a thunk) that the catch is protecting, and the function to call if a matching error occurs during the evaluation of the thunk. The error handler takes a rest argument which will hold whatever the error function chooses to pass it. The error function itself takes at least 2 arguments, the error type (a symbol), and the error message. There may also be other arguments describing the error. The default action (in the absence of any catch) is to treat the message as a format control string, apply format to it and the other arguments, and send that info to the current-error-port.
When an error is encountered, the variable *error-info* (a vector) contains additional info about that error:
To find a variable's value at the point of the error:
(symbol->value var (vector-ref *error-info* 5))
To print the stack at the point of the error:
(stacktrace *error-info*)
The variable *error-hook* provides a way to specialize error reporting. It is a function of 2 arguments, the values passed by the error function (the error type and whatever other info accompanies it).
(set! *error-hook* (lambda (tag args) (apply format (cons #t args))))
See also stacktrace and trace below. There is a break macro defined in Snd (see snd-xen.c) which allows you to stop at some point, then evaluate arbitrary expressions in that context.
These functions provide tracing:
(define (hiho arg) (if (> arg 0) (+ 1 (hiho (- arg 1))) 0)) (trace hiho) (hiho 3) [hiho 3] [hiho 2] [hiho 1] [hiho 0] 0 1 2 3
trace adds a function to the list of functions being traced, and untrace removes it.
stacktrace prints the stack contents. Its optional argument can be *error-info* to show the stack at the point of the last error, a thread object to show that thread's stack, or a continuation to show the continuation stack. Similarly, the stack function returns the stack top (an integer) and the stack itself (a vector). Each stack frame has 4 entries, the function, the current environment, the function arguments, and an op code used internally by the evaluator.
Besides files, ports can also represent strings and functions. The string port functions are:
(let ((result #f) (p (open-output-string))) (format p "this ~A ~C test ~D" "is" #\a 3) (set! result (get-output-string p)) (close-output-port p) result) -> "this is a test 3"
Other functions:
The variable *vector-print-length* sets the upper limit on how many vector elements are printed by object->string and format.
When running s7 behind a GUI, you often want input to come from and output to go to arbitrary widgets. The "function ports" provide a way to redirect IO. See s7.h for an example.
s7 also includes current-error-port and set-current-error-port.
length, copy, and fill! are generic functions in the sense that their argument can be a list, string, vector, hash-table, or C-defined object. Since vectors and lists are set-applicable, and length is generic, we can write a generic FFT that accepts both types or any other object that follows this syntax:
(define* (cfft! data n (dir 1)) ; (complex data) (if (not n) (set! n (length data))) (do ((i 0 (+ i 1)) (j 0)) ((= i n)) (if (> j i) (let ((temp (data j))) (set! (data j) (data i)) (set! (data i) temp))) (let ((m (/ n 2))) (do () ((or (< m 2) (< j m))) (set! j (- j m)) (set! m (/ m 2))) (set! j (+ j m)))) (let ((ipow (floor (log n 2))) (prev 1)) (do ((lg 0 (+ lg 1)) (mmax 2 (* mmax 2)) (pow (/ n 2) (/ pow 2)) (theta (make-rectangular 0.0 (* pi dir)) (* theta 0.5))) ((= lg ipow)) (let ((wpc (exp theta)) (wc 1.0)) (do ((ii 0 (+ ii 1))) ((= ii prev)) (do ((jj 0 (+ jj 1)) (i ii (+ i mmax)) (j (+ ii prev) (+ j mmax))) ((>= jj pow)) (let ((tc (* wc (data j)))) (set! (data j) (- (data i) tc)) (set! (data i) (+ (data i) tc)))) (set! wc (* wc wpc))) (set! prev mmax)))) data) > (cfft! (list 0.0 1+i 0.0 0.0)) (1+1i -1+1i -1-1i 1-1i) > (cfft! (vector 0.0 1+i 0.0 0.0)) #(1+1i -1+1i -1-1i 1-1i)
map and for-each are also generic.
If s7 is built with WITH_MULTIDIMENSIONAL_VECTORS (the default), it supports vectors with any number of dimensions. It is here, in particular, that the generalized set! stuff shines. make-vector's 2nd argument can be a list of dimensions, rather than an integer (the one dimensional case):
(make-vector (list 2 3 4)) (make-vector '(2 3) 1.0) (vector-dimensions (make-vector (list 2 3 4))) -> (2 3 4)
The second example includes the optional default vector element. Once defined, (vect i ...) or (to be very verbose, (vector-ref vect i ...)) returns the given element, and (set! (vect i ...) m), (or verbose and unreadable, (vector-set! vect i ... m)) sets that element. vector-dimensions returns a list of the dimensions of a vector.
(define v (make-vector '(2 3) 1.0)) -> #(1.0 1.0 1.0 1.0 1.0 1.0) (set! (v 0 1) 2.0) -> #(1.0 2.0 1.0 1.0 1.0 1.0) (v 0 1) -> 2.0
*load-path* is a list of directories to search when loading a file. *load-hook* is a function called just before a file is loaded. Its argument is the filename. While loading, port-filename and port-line-number (of the current-input-port) can tell you where you are in the file.
(set! *load-hook* (lambda (name) (format #t "loading ~S...~%" name)))
As in Common Lisp, *features* is a list describing what is currently loaded into s7. You can check it with the provided? function, or add something to it with provide. In my version of Snd, at startup *features* is:
> *features* (snd10 snd snd-s7 snd-motif gsl alsa xm snd-ladspa run clm4 clm sndlib gmp multidimensional-vectors s7) > (provided? 'gmp) #t
procedure-source, procedure-arity, procedure-documentation, and help provide a look into a scheme function. procedure-documentation returns the documentation string associated with a procedure (the initial string in the function's body). procedure-arity returns a list describing the argument list of a function: '(required-args optional-args rest-arg). procedure-source returns the source (as a list) of a procedure. procedure-environment returns a procedure's environment.
> (define* (add-2 a (b 32)) "add-2 adds its 2 args" (+ a b)) add-2 > (procedure-documentation add-2) "add-2 adds its 2 args" > (procedure-arity add-2) (0 2 #f) > (procedure-source add-2) (lambda* (a (b 32)) "add-2 adds its 2 args" (+ a b))
(symbol-table) returns the symbol table, a vector of lists of symbols. (symbol->value sym :optional env) returns the binding of 'sym' in the given environment which defaults to the current environment. (defined? obj :optional env) returns #t if 'obj' has a binding (a value) in the environment 'env'. If profiling is enabled (set WITH_PROFILING in s7.c), (symbol-calls sym) returns the number of times that symbol's binding has been applied. Here we scan the symbol table for any function that doesn't have documentation:
(let ((st (symbol-table))) (do ((i 0 (+ i 1))) ((= i (vector-length st))) (let ((lst (vector-ref st i))) (for-each (lambda (sym) (if (defined? sym) (let ((val (symbol->value sym))) (if (and (procedure? val) (string=? "" (procedure-documentation val))) (format #t "~A " sym))))) lst))))
environments are "first class objects" in s7. An environment is a list of alists ending with a hash-table (the global environment). (current-environment :optional thread) returns the current environment (symbol bindings). (global-environment) returns the top-level environment. (procedure-environment proc) returns the procedure proc's environment. Here is an example of "apropos" that accesses both environments:
(define (apropos name) ;; (apropos "name") prints out a list of all symbols whose name includes "name" as a substring (define (substring? subs s) ; from Larceny (let* ((start 0) (ls (string-length s)) (lu (string-length subs)) (limit (- ls lu))) (let loop ((i start)) (cond ((> i limit) #f) ((do ((j i (+ j 1)) (k 0 (+ k 1))) ((or (= k lu) (not (char=? (string-ref subs k) (string-ref s j)))) (= k lu))) i) (else (loop (+ i 1))))))) (define (apropos-1 alist) (for-each (lambda (binding) (if (substring? name (symbol->string (car binding))) (format (current-output-port) "~A: ~A~%" (car binding) (if (procedure? (cdr binding)) (procedure-documentation (cdr binding)) (cdr binding))))) alist)) (for-each (lambda (frame) (if (vector? frame) ; the global environment (let ((len (vector-length frame))) (do ((i 0 (+ i 1))) ((= i len)) (apropos-1 (vector-ref frame i)))) (apropos-1 frame))) (current-environment)))
You can change the current environment by hand:
(define (push-environment e binding) (if (vector? (car e)) (begin (set-cdr! e (list (car e))) (set-car! e (list binding))) (set-car! e (cons binding (car e))))) (define (pop-environment e) (if (not (vector? (car e))) (begin (set-car! e (cadr e)) (set-cdr! e (cddr e))))) (define-macro (define! e var val) ; define var=val in env e `(push-environment ,e (cons ',var ,val))) (define (make-environment . initial-bindings) (cons initial-bindings (global-environment))) (let ((x 3)) (define! (current-environment) hi 21) (+ x hi)) -> 24 (let ((x 32)) (eval `(+ x y) (make-environment '(x . 2) '(y . 4)))) -> 6
(with-environment env . body) evaluates its body in the environment env. Unless I'm missing something, I think this makes it possible to write "hygenic" macros:
(define-macro (mac a b) `(with-environment (global-environment) (+ ,a ,b)))
now if we rebind +, nothing goes wrong:
(let ((+ -)) (mac 1 2)) 3
encapsulation saves and restores environments.
An encapsulator is a sort of data-side continuation. open-encapsulator remembers the overall environment at the point it is called, returning an encapuslator object. Whenever we want to return to that data state, we call that object as a thunk. encapsulator-bindings returns the alist of variables awaiting restoration. When the encapsulator is called (restoring those bindings), the list is cleared, and the encapsulator starts saving values again (so repeated calls keep returning you to that data state). close-encapsulator turns that encapsulator off. In a REPL, for example, you could save the initial state, then return to it at any time, without restarting the interpreter. fluid-let is not what we want here because it has a body, and requires that you list in advance what variables you want to protect (and besides, it's not really a let (it uses "set!") and I can't see anything fluid about it). encapsulate is a macro that evaluates its body, then returns any variables global to that code to their prior value.
> (define global-x 32) global-x > (encapsulate (set! global-x 123) (format #f "x: ~A" global-x)) "x: 123" > global-x 32
eval evaluates its argument (a list representing a piece of code). It takes an optional second argument, the environment in which the evaluation should take place. eval-string is similar, but its argument is a string.
> (eval `(+ 1 2)) 3 > (eval-string "(+ 1 2)") 3
reverse! is an in-place version of the built-in function reverse. That is, it modifies the list passed to it in the process of reversing its contents. list-set! sets a member of a list. sort! sorts a list or a vector using the function passed as its second argument to choose the new ordering.
> (sort! (list 3 4 8 2 0 1 5 9 7 6) <) (0 1 2 3 4 5 6 7 8 9) > (sort! (list (list 'u 1) (list 'i 0) (list 'a 2)) (lambda (a b) (< (cadr a) (cadr b)))) ((i 0) (u 1) (a 2))
Despite the "!" in its name, sort! actually copies any list argument passed to it, but vectors are sorted in place.
Keywords exist mainly for define*'s benefit. The keyword functions are: keyword?, make-keyword, symbol->keyword, and keyword->symbol. A keyword is a symbol that starts or ends with a colon. The colon is considered to be a part of the symbol name (unlike CL where it signals that the symbol is in the Package-With-No-Name [offstage: harmonica, tubular bells...]).
(help obj) tries to find information about obj.
The r5rs section about values makes no sense to me; why have multiple values at all if you're simply going to throw away all but the first value? In s7 (+ (values 1 2 3) 4) is 10. Similarly,
(string-ref ((lambda () (values "abcd" 2)))) -> #\c ((lambda (a b) (+ a b)) ((lambda () (values 1 2)))) -> 3 ;; call-with-values: (define-macro (call-with-values producer consumer) `(,consumer (,producer))) ;; multiple-value-bind ("receive" in srfi-8): (define-macro (multiple-value-bind vars expr . body) `((lambda ,vars ,@body) ,expr)) ;; multiple-value-set!: (define-macro (multiple-value-set! vars expr . body) (let ((local-vars (map (lambda (n) (gensym)) vars))) `((lambda ,local-vars ,@(map (lambda (n ln) `(set! ,n ,ln)) vars local-vars) ,@body) ,expr))) ;; call/cc returns multiple values: (+ (call/cc (lambda (ret) (ret 1 2 3))) 4) -> 10 ;; let*-values is defined as a macro at the end of s7.c (commented out)
In Snd many functions take the same trailing arguments: sound-index, channel-number, and edit-position; we can package these up in a values call:
;; say we have those arguments in snd, chn, edpos (defmacro sce () `(values ,snd ,chn ,edpos)) (maxamp (sce))
quit exits s7.
This is named "delay" in most Schemes, but that name belongs to CLM. There is also promise? which returns #t if its argument is a promise.
The gc function either calls the GC (if passed no arguments), or turns the GC either on: (gc #t) or off: (gc #f).
This defines read-time macros, which are just dangerous enough that I probably shouldn't document them. It has the same syntax as define-macro, and the same result except that the macro is dealt with at read time! (This means it does not respect attempts to bind it to something else, which is asking for confusion).