The s7 tarball includes several scheme files:
libc.scm, libgsl.scm, libm.scm, libdl.scm, notcurses_s7.c, libutf8proc.scm, and libgdbm.scm tie the associated libraries into s7. gdbinit has some gdb commands for s7.
cload.scm defines the macro c-define that reduces the overhead involved in (dynamically) linking C entities into s7.
(c-define c-info (prefix "") (headers ()) (cflags "") (ldflags "") output-name)
For example, (c-define '(double j0 (double)) "m" "math.h")
links the C math library function j0 into s7 under the name m:j0,
passing it a double argument and getting a double result (a real in s7).
prefix is some arbitrary prefix that you want prepended to various names.
headers is a list of headers (as strings) that the c-info relies on, (("math.h") for example).
cflags are any special C compiler flags that are needed ("-I." in particular), and ldflags is the similar case for the loader. output-name is the name of the output C file and associated library. It defaults to "temp-s7-output" followed by a number. In libm.scm, it is set to "libm_s7" to protect it across cload calls. If cload finds an up-to-date output C file and shared library, it simply loads the library, rather than going through all the trouble of writing and compling it.
c-info is a list that describes the C entities that you want to load into s7. It can be either one list describing one entity, or a list of such lists. Each description has the form:
(return-type entity-name-in-C (argument-type...))
where each entry is a symbol, and C names are used throughout. So, in the j0
example above, (double j0 (double)) says we want access to j0, it returns
a C double, and it takes one argument, also a C double. s7 tries to figure out
what the corresponding s7 type is, but in tricky cases, you should tell it
by replacing the bare type name with a list: (C-type underlying-C-type). For example,
the Snd function set_graph_style takes an (enum) argument of type graph_style_t.
This is actually an int, so we use (graph_style_t int) as the type:
(void set_graph_style ((graph_style_t int)))
If the C entity is a constant, then the descriptor list has just two entries,
the C-type and the entity name: (int F_OK) for example. The entity name can also be a list:
((graph_style_t int) (GRAPH_LINES GRAPH_DOTS GRAPH_FILLED GRAPH_DOTS_AND_LINES GRAPH_LOLLIPOPS))
This defines all the names in the list as integers.
If the C type has a space ("struct tm*"), use (symbol "struct tm*")
to construct the corresponding symbol.
The entity is placed in the current s7 environment under the name (string-append prefix ":" name)
where the ":" is omitted if the prefix is null. So in the j0 example, we get in s7 the function m:j0.
c-define returns #t if it thinks the load worked, and #f otherwise.
There are times when the only straightforward approach is to write the desired C code directly. To insert C code on the fly, use (in-C "code..."). Two more such cases that come up all the time: C-function for linkage to functions written directly in s7 style using in-C, and C-macro for macros in the C header file that need to be wrapped in #ifdefs. Here are some examples:
;;; various math library functions
(c-define '((double j0 (double))
(double j1 (double))
(double erf (double))
(double erfc (double))
(double lgamma (double)))
"m" "math.h")
;;; getenv and setenv
(c-define '(char* getenv (char*)))
(c-define '(int setenv (char* char* int)))
;;; file-exists? and delete-file
(define file-exists? (let () ; define F_OK and access only within this let
(c-define '((int F_OK) (int access (char* int))) "" "unistd.h")
(lambda (arg) (= (access arg F_OK) 0))))
(define delete-file (let ()
(c-define '(int unlink (char*)) "" "unistd.h")
(lambda (file) (= (unlink file) 0)))) ; 0=success
;;; examples from Snd:
(c-define '(char* version_info ()) "" "snd.h" "-I.")
(c-define '(mus_float_t mus_degrees_to_radians (mus_float_t)) "" "snd.h" "-I.")
(c-define '(snd_info* any_selected_sound ()) "" "snd.h" "-I.")
(c-define '(void select_channel (snd_info* int)) "" "snd.h" "-I.")
(c-define '(((graph_style_t int) (GRAPH_LINES GRAPH_DOTS GRAPH_FILLED GRAPH_DOTS_AND_LINES GRAPH_LOLLIPOPS))
(void set_graph_style ((graph_style_t int))))
"" "snd.h" "-I.")
;;; getcwd, strftime
(c-define '(char* getcwd (char* size_t)) "" "unistd.h")
(c-define (list '(void* calloc (size_t size_t))
'(void free (void*))
'(void time (time_t*)) ; ignore returned value
(list (symbol "struct tm*") 'localtime '(time_t*))
(list 'size_t 'strftime (list 'char* 'size_t 'char* (symbol "struct tm*"))))
"" "time.h")
> (let ((p (calloc 1 8))
(str (make-string 32)))
(time p)
(strftime str 32 "%a %d-%b-%Y %H:%M %Z" (localtime p))
(free p)
str)
"Sat 11-Aug-2012 08:55 PDT\x00 "
;;; opendir, read_dir, closedir
(c-define '((int closedir (DIR*))
(DIR* opendir (char*))
(in-C "static char *read_dir(DIR *p) \
{ \
struct dirent *dirp; \
dirp = readdir(p); \
if (!dirp) return(NULL); \
return(dirp->d_name); \
}")
(char* read_dir (DIR*)))
"" '("sys/types.h" "dirent.h"))
C-init inserts its string argument into the initialization section of the module. In libgsl.scm, for example,
(C-init "gsl_set_error_handler(g_gsl_error);")
inserts that string (as C code) into libgsl_s7.c toward the beginning of the libgsl_s7_init function (line 42346 or so).
When compiling, for the simple cases above, include "-ldl -Wl,-export-dynamic" in the gcc command. So the first FFI example is built (this is in Linux):
gcc -c s7.c -I. gcc -o ex1 ex1.c s7.o -lm -I. -ldl -Wl,-export-dynamic ex1 > (load "cload.scm") c-define-1 > (c-define '(double j0 (double)) "m" "math.h") #t > (m:j0 0.5) 0.93846980724081
See also r7rs.scm, libc.scm, libgsl.scm, libm.scm, libdl.scm, and libgdbm.scm. libutf8proc.scm exists, but I have not tested it at all.
The default in the lib*.scm files is to use the C name as the Scheme name. This collides with (for example) the widespread use of "-", rather than "_" in Scheme, but I have found it much more straightforward to stick with one name. In cases like libgsl there are thousands of names, all documented at great length by the C name. Anyone who wants to use these functions has to start with the C name. If they are forced to fuss with some annoying Schemely translation of it, the only sane response is: "forget it! I'll do it in C".
(require libc.scm)
(define (copy-file in-file out-file)
(with-let (sublet *libc* :in-file in-file :out-file out-file)
;; the rest of the function body exists in the *libc* environment, with the
;; function parameters in-file and out-file imported, so, for example,
;; (open ...) below calls the libc function open.
(let ((infd (open in-file O_RDONLY 0)))
(if (= infd -1)
(error 'io-error "can't find ~S~%" in-file)
(let ((outfd (creat out-file #o666)))
(if (= outfd -1)
(begin
(close infd)
(error 'io-error "can't open ~S~%" out-file))
(let* ((BUF_SIZE 1024)
(buf (malloc BUF_SIZE)))
(do ((num (read infd buf BUF_SIZE) (read infd buf BUF_SIZE)))
((or (<= num 0)
(not (= (write outfd buf num) num)))))
(close outfd)
(close infd)
(free buf)
out-file)))))))
(define (glob->list pattern)
(with-let (sublet *libc* :pattern pattern)
(let ((g (glob.make)))
(glob pattern 0 g)
(let ((res (glob.gl_pathv g)))
(globfree g)
res))))
;; now (load "*.scm") is (for-each load (glob->list "*.scm"))
;; a couple regular expression examples
(with-let (sublet *libc*)
(define rg (regex.make))
(regcomp rg "a.b" 0)
(display (regexec rg "acb" 0 0)) (newline) ; 0 = match
(regfree rg))
(with-let (sublet *libc*)
(define rg (regex.make))
(let ((res (regcomp rg "colou\\?r" 0)))
(if (not (zero? res))
(error 'regex-error "~S: ~S~%" "colou\\?r" (regerror res rg)))
(set! res (regexec rg "The color green" 1 0))
(display res) (newline) ; #i(4 9) = match start/end
(regfree rg)))
(require libgsl.scm)
(define (eigenvalues M)
(with-let (sublet *libgsl* :M M)
(let* ((len (sqrt (length M)))
(gm (gsl_matrix_alloc len len))
(m (float-vector->gsl_matrix M gm))
(evl (gsl_vector_complex_alloc len))
(evc (gsl_matrix_complex_alloc len len))
(w (gsl_eigen_nonsymmv_alloc len)))
(gsl_eigen_nonsymmv m evl evc w)
(gsl_eigen_nonsymmv_free w)
(gsl_eigen_nonsymmv_sort evl evc GSL_EIGEN_SORT_ABS_DESC)
(let ((vals (make-vector len)))
(do ((i 0 (+ i 1)))
((= i len))
(set! (vals i) (gsl_vector_complex_get evl i)))
(gsl_matrix_free gm)
(gsl_vector_complex_free evl)
(gsl_matrix_complex_free evc)
vals))))
We can use gdbm (or better yet, mdb), the :readable argument to object->string, and the fallback methods in the environments to create name-spaces (lets) with billions of thread-safe local variables, which can be saved and communicated between s7 runs:
(require libgdbm.scm)
(with-let *libgdbm*
(define *db*
(openlet
(inlet :file (gdbm_open "test.gdbm" 1024 GDBM_NEWDB #o664
(lambda (str) (format *stderr* "gdbm error: ~S~%" str)))
:let-ref-fallback (lambda (obj sym)
(eval-string (gdbm_fetch (obj 'file) (symbol->string sym))))
:let-set-fallback (lambda (obj sym val)
(gdbm_store (obj 'file)
(symbol->string sym)
(object->string val :readable)
GDBM_REPLACE)
val)
:make-iterator (lambda (obj)
(let ((key #f)
(length (lambda (obj) (expt 2 20))))
(#_make-iterator
(let ((+iterator+ #t))
(openlet
(lambda ()
(if key
(set! key (gdbm_nextkey (obj 'file) (cdr key)))
(set! key (gdbm_firstkey (obj 'file))))
(if (pair? key)
(cons (string->symbol (car key))
(eval-string (gdbm_fetch (obj 'file) (car key))))
key))))))))))
(set! (*db* 'str) "123") ; add a variable named 'str with the value "123"
(set! (*db* 'int) 432)
(with-let *db*
(+ int (length str))) ; -> 435
(map values *db*) ; -> '((str . "123") (int . 432))
(gdbm_close (*db* 'file)))
See gthreads for a C-side example.
case.scm has case*, a compatible extension of case that includes pattern matching.
(case* selector ((target...) body) ...) uses equivalent? to match the
selector to the targets, evaluating the body associated with the first matching target.
If a target is a list or vector, the elements are checked item by item.
Each target, or element of a list or vector can be a pattern. Patterns
are of the form #<whatever> (undefined constants from s7's pointer of view).
A pattern can be:
If a label occurs in the result body, the expression it labelled is substituted for it.
(case* x ((3.14) 'pi)) ; returns 'pi if x is 3.14
(case* x ((#<symbol?>))) ; returns #t if x is a symbol
(case* x (((+ 1 #<symbol?>)))) ; matches any list of the form '(+ 1 x) or any symbol in place of "x"
(case* x (((#<symbol?> #<e1:...> (+ #<e2:...>)))
(append #<e1> #<e2>))) ; passed '(a b c d (+ 1 2)), returns '(b c d 1 2)
(case* x ((#<"a.b">))) ; matches if x is a string "a.b" where "." matches anything
(define (palindrome? x)
(case* x
((() (#<>))
#t)
(((#<start:> #<middle:...> #<start>))
(palindrome? #<middle>))
(else #f)))
case*'s matching function can be used anywhere.
(let ((match? ((funclet 'case*) 'case*-match?))) ; this is case*'s matcher
(match? x '(+ #<symbol?> 1))) ; returns #t if x is of the form '(+ x 1), x any symbol
(define match+
(let ((match? ((funclet 'case*) 'case*-match?))
(labels ((funclet 'case*) 'case*-labels))) ; these are the labels and their values
(macro (arg)
(cond ((null? arg) ())
((match? arg '(+ #<a:> (+ #<b:...>))) `(+ ,(labels 'a) ,@(cadr (labels 'b))))
((match? arg '(+ #<> #<>)) `(+ ,@(cdr arg)))
(else #f)))))
;; (match+ (+ 1 (+ 2 3))) -> 6
See case.scm and s7test.scm for many more examples, including let and hash-table matching.
debug.scm has various debugging aids, including trace, break, watch, and a C-style stacktrace. The *s7* field 'debug controls when these are active, and to what extent.
(trace func) adds a tracepoint to the start of the function or macro func. (trace) adds such tracing to every subsequently defined function or macro. (untrace) turns off tracing; (untrace func) turns off tracing in func. Similarly (break func) places a breakpoint at the start of func, (unbreak func) removes it. (unbreak) removes all breakpoints. When a breakpoint is encountered, you are placed in a repl at that point; type C-q to continue. To trace a variable, use (watch var). watch reports whenever var is set! and (unwatch var) removes the watchpoint.
These trace, break and watchpoints are active only if (*s7* 'debug) is positive. If 'debug is 1, existing traces and breaks are active, but no new ones are added by s7. If 'debug is 2, s7 adds tracepoints to any subsequently defined (i.e. named) functions and macros. If (*s7* 'debug) is 3, unnamed functions are also traced. If any tracing is enabled, you can get a C-style stacktrace by setting (debug-stack) to a vector, then call (show-debug-stack) to see the calls.
Besides debug-stack, debug.scm also defines the convenience functions debug-function, debug-port, and debug-repl. debug-port is the debugger's output port, debug-repl drops into a repl at a breakpoint, and debug-function provides a way to customize the debugger's behavior. The function debug-frame provides a way to examine local variables.
> (define (g1 x) (+ x 1)) g1 > (trace g1) ; this loads debug.scm unless it's already loaded, and sets (*s7* 'debug) to 1 g1 > (procedure-source g1) ; you can add trace-in explicitly (rather than call trace) (lambda (x) (trace-in (curlet)) (+ x 1)) > (g1 2) (g1 2) ; file/line info is included if relevant -> 3 3 > (break g1) g1 > (g1 3) break: (g1 3), C-q to exit break break> x ; this is a repl started at the breakpoint 3 break> -> 4 ; C-q typed to exit the break 4 > (define var 1) 1 > (watch var) #<lambda (s v ...)> ; this is the new setter for 'var > (set! var 3) var set! to 3 3 > (define lt (inlet 'a 3)) (inlet 'a 3) > (watch (lt 'a)) #<lambda (s v ...)> > (set! (lt 'a) 12) let-set! a to 12 12
s7test.scm has more examples
lint tries to find errors or infelicities in your scheme code. To try it:
(load "lint.scm") (lint "some-code.scm")
There are several variables at the start of lint.scm to control additional output:
*report-unused-parameters* *report-unused-top-level-functions* *report-shadowed-variables* *report-undefined-identifiers* *report-multiply-defined-top-level-functions* *report-nested-if* *report-short-branch* *report-one-armed-if* *report-loaded-files* *report-any-!-as-setter* *report-doc-strings* *report-func-as-arg-arity-mismatch* *report-bad-variable-names* *report-built-in-functions-used-as-variables* *report-forward-functions* *report-sloppy-assoc* *report-bloated-arg* *report-clobbered-function-return-value* *report-boolean-functions-misbehaving* *report-repeated-code-fragments* *report-quasiquote-rewrites* *report-combinable-lets*
See lint.scm for more about these switches. You can also extend lint by adding your own code, or adding your functions to lint's tables, or most simply by defining signatures for your functions. snd-lint.scm performs these tasks for Snd. (lint exports its innards via *lint*). lint is not smart about functions defined outside the current file, so *report-undefined-variables* sometimes gets confused. You'll sometimes get a recommendation from lint that is less than helpful; nobody's perfect. If it's actually wrong, and not just wrong-headed, please let me know. Also in lint.scm are html-lint and C-lint. html-lint reads an HTML file looking for Scheme code. If any is found, it runs s7 and then lint over it, reporting troubles. Similarly C-lint reads a C file looking for s7_eval_c_string and running lint over its string.
There are three or four repls included with s7. repl.scm is a textual interface based on vt-100 codes, and nrepl.scm is an improvement of repl.scm based on the notcurses-core library. I'll treat repl.scm first, then discuss how nrepl differs from it.
repl.scm implements a repl using vt100 codes and libc.scm. It includes
symbol and filename completion, a history buffer, paren matching,
indentation, multi-line edits, and a debugger window.
To move around in the history buffer, use M-p, M-n or M-. (C-p and C-n are used to move the cursor in the current expression).
You can change the keymap or the prompt; all the repl functions are
accessible through the *repl* environment. One field is 'repl-let which
gives you access to all the repl's internal variables and functions.
Another is 'top-level-let, normally (sublet (rootlet)), which is the environment in
which the repl's evaluation takes place. You can reset the repl back to its
starting point with: (set! (*repl* 'top-level-let) (sublet (rootlet))).
You can save the current repl state via ((*repl* 'save-repl)), and
restore it later via ((*repl* 'restore-repl)). The repl's saved state
is in the file save.repl, or the filename can be passed as an argument to save-repl and restore-repl.
There is one annoying consequence of using (sublet (rootlet)) for the top-level let: if you define something in the repl, then load a file that expects to find that thing in rootlet, it won't:
<1> (define (func x) (+ x 1)) ; func is in (sublet (rootlet)) func <2> (load "use-func.scm") ; file contents: (display (func 3)) error: unbound variable func
To get around this, either load the file into curlet: (load "use-func.scm" (curlet)),
or use with-let to place the definition in rootlet: (with-let (curlet) (define (func x) (+ x 1))).
Meta keys are a problem on the Mac. You can use ESC instead, but that requires super-human capacities. I stared at replacement control keys, and nothing seemed right. If you can think of something, it's easy to define replacements: see repl.scm which has a small table of mappings.
To run the repl, either build s7 with the compiler flag -DWITH_MAIN, or conjure up a wrapper:
#include "s7.h"
int main(int argc, char **argv)
{
s7_scheme *sc = s7_init();
s7_load(sc, "repl.scm");
s7_eval_c_string(sc, "((*repl* 'run))");
return(0);
}
/* gcc -o r r.c s7.o -Wl,-export-dynamic -lm -I. -ldl
*/
Besides evaluating s7 expressions, like any repl, you can also type shell commands just as in a shell:
<1> pwd /home/bil/cl <2> cd .. /home/bil <3> date Wed 15-Apr-2015 17:32:24 PDT
In most cases, these are handled through *unbound-variable-hook*, checked using "command -v", then passed to the underlying shell via the system function.
The prompt is set by the function (*repl* 'prompt). It gets one argument, the current line number, and should set the prompt string and its length.
(set! (*repl* 'prompt) (lambda (num) (with-let (*repl* 'repl-let) (set! prompt-string "scheme> ") (set! prompt-length (length prompt-string)))))
or, to use the red lambda example mentioned earlier:
(set! (*repl* 'prompt)
(lambda (num)
(with-let (*repl* 'repl-let)
(set! prompt-string (bold (red (string #\xce #\xbb #\> #\space))))
(set! prompt-length 3)))) ; until we get unicode length calc
The line number provides a quick way to move around in the history buffer. To get a previous line without laboriously typing M-p over and over, simply type the line number (without control or meta bits), then M-. In some CL repls, the special variable '* holds the last value computed. In repl.scm, each value is retained in variables of the form '<n> where n is the number shown in the prompt.
<1> (+ 1 2) 3 <2> (* <1> 2) 6
Here is an example of adding to the keymap:
(set! ((*repl* 'keymap) (integer->char 17)) ; C-q to quit and return to caller
(lambda (c)
(set! ((*repl* 'repl-let) 'all-done) #t)))
To access the meta keys (in the keymap), use a string:
((*repl* 'keymap) (string #\escape #\p)); this is Meta-p which normally accesses
the history buffer.
You can call the repl from other code, poke around in the current environment (or whatever), then return to the caller:
(load "repl.scm")
(define (drop-into-repl e)
(let ((C-q (integer->char 17))) ; we'll use the C-q example above to get out
(let ((old-C-q ((*repl* 'keymap) C-q))
(old-top-level (*repl* 'top-level-let)))
(dynamic-wind
(lambda ()
(set! (*repl* 'top-level-let) e)
(set! ((*repl* 'keymap) C-q)
(lambda (c)
(set! ((*repl* 'repl-let) 'all-done) #t))))
(lambda ()
((*repl* 'run))) ; run the repl
(lambda ()
(set! (*repl* 'top-level-let) old-top-level)
(set! ((*repl* 'keymap) C-q) old-C-q))))))
(let ((x 32))
(format *stderr* "x: ~A~%" x)
(drop-into-repl (curlet))
(format *stderr* "now x: ~A~%" x))
Now load that code and:
x: 32 <1> x 32 <2> (set! x 91) 91 <3> x 91 <4> now x: 91 ; here I typed C-q at the prompt
Another possibility:
(set! (hook-functions *error-hook*)
(list (lambda (hook)
(apply format *stderr* (hook 'data))
(newline *stderr*)
(drop-into-repl (owlet)))))
See the end of repl.scm for more examples. See nrepl.scm for a better version of repl.scm.
Unlike repl, nrepl has support for the mouse, traversable, scrollable, and resizable panes, built-in ties to lint.scm, debug.scm, and profile.scm, and various other enhancements. Since it includes all the libc, notcurses FFI code, and nrepl.scm at compile-time, there are no problems running it anywhere. To build nrepl:
gcc -o nrepl s7.c -O2 -I. -Wl,-export-dynamic -lm -ldl -DWITH_MAIN -DWITH_NOTCURSES -lnotcurses-core
If that is too easy, try:
gcc -c s7.c -O2 -I. -Wl,-export-dynamic -lm -ldl gcc -o nrepl nrepl.c s7.o -lnotcurses-core -lm -I. -ldl
notcurses_s7.c needs version 2.1.6 or later of the notcurses-core library.
When nrepl starts up, you have a prompt at the top of the terminal, and a status box at the bottom. You can move around the pane via C-p and C-n (no need for repl.scm's M-p and M-n), or use the mouse, or the arrow keys. If you set and hit a break point, a new pane is opened in the context of the break. C-q exits the break. At the top pane, C-q exits nrepl. C-g gives you another prompt (handy if you're caught in a messed up expression). If you're in an infinite loop, C-c interrupts it. Otherwise C-c exits nrepl.
If you set up a watcher (via watch from debug.scm), the action is displayed in a separate box in the upper right corner. The status box displays all sorts of informative and helpful messages, or at least that is the intent. lint.scm checks each expression you type, and various hooks let you know when things are happening in the background. Function signatures are posted there as well.
You can customize nrepl in basically the same ways as described above for repl.scm. You can also place these in a file named ".nrepl"; if nrepl finds such a file, it loads it automatically at startup.