source: project/chicken/branches/release/scheme-complete.el @ 7931

Last change on this file since 7931 was 7931, checked in by felix winkelmann, 12 years ago

merged from prerelease branch rev. 7930 - release version 3.0.0; fixed wrong version numbers in some files

File size: 156.7 KB
Line 
1;;; scheme-complete.el              -*- Emacs-Lisp -*-
2
3;;; Smart tab completion for Emacs
4
5;;; This code is written by Alex Shinn and placed in the Public
6;;; Domain.  All warranties are disclaimed.
7
8;;; This file provides a single function, `scheme-smart-complete',
9;;; which you can use for intelligent, context-sensitive completion
10;;; for any Scheme implementation.  To use it just load this file and
11;;; bind that function to a key in your preferred mode:
12;;;
13;;; (autoload 'scheme-smart-complete "scheme-complete" nil t)
14;;; (eval-after-load 'scheme
15;;;   '(progn (define-key scheme-mode-map "\e\t" 'scheme-smart-complete)))
16;;;
17;;; Alternately, you may want to just bind TAB to the
18;;; `scheme-complete-or-indent' function, which indents at the start
19;;; of a line and otherwise performs the smart completion:
20;;;
21;;; (eval-after-load 'scheme
22;;;   '(progn (define-key scheme-mode-map "\t" 'scheme-complete-or-indent)))
23;;;
24;;; If you use eldoc-mode (included in Emacs), you can also get live
25;;; scheme documentation with:
26;;;
27;;; (autoload 'scheme-get-current-symbol-info "scheme-complete" nil t)
28;;; (add-hook 'scheme-mode-hook
29;;;   (lambda ()
30;;;     (make-local-variable 'eldoc-documentation-function)
31;;;     (setq eldoc-documentation-function 'scheme-get-current-symbol-info)
32;;;     (eldoc-mode)))
33;;;
34;;; There's a single custom variable, `default-scheme-implementation',
35;;; which you can use to specify your preferred implementation when we
36;;; can't infer it from the source code.
37;;;
38;;; That's all there is to it.
39
40;;; History:
41;;;   0.7: 2008/01/18 - handles higher-order types (for apply, map, etc.)
42;;;                     smarter string completion (hostname, username, etc.)
43;;;                     smarter type inference, various bugfixes
44;;;   0.6: 2008/01/06 - more bugfixes (merry christmas)
45;;;   0.5: 2008/01/03 - handling internal defines, records, smarter
46;;;                     parsing
47;;;   0.4: 2007/11/14 - silly bugfix plus better repo env support
48;;;                     for searching chicken and gauche modules
49;;;   0.3: 2007/11/13 - bugfixes, better inference, smart strings
50;;;   0.2: 2007/10/15 - basic type inference
51;;;   0.1: 2007/09/11 - initial release
52;;;
53;;;   What is this talk of 'release'? Klingons do not make software
54;;;   'releases'. Our software 'escapes' leaving a bloody trail of
55;;;   designers and quality assurance people in its wake.
56
57(require 'cl)
58
59;; this is just to eliminate some warnings when compiling - this file
60;; should be loaded after 'scheme
61(eval-when (compile)
62  (require 'scheme))
63
64;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
65;; info
66;;
67;; identifier type [doc-string no-type-display?]
68;;
69;; types:
70;;
71;;   pair, number, symbol, etc.
72;;   (lambda (param-types) [return-type])
73;;   (syntax (param-types) [return-type])
74;;   (set name values ...)
75;;   (flags name values ...)
76;;   (list type)
77;;   (string expander)
78;;   (special type function [outer-function])
79
80(defvar *scheme-r5rs-info*
81  '((define (syntax (identifier value) undefined) "define a new variable")
82    (set! (syntax (identifier value) undefined) "set the value of a variable")
83    (let (syntax (vars body |...|)) "bind new local variables in parallel")
84    (let* (syntax (vars body |...|)) "bind new local variables sequentially")
85    (letrec (syntax (vars body |...|)) "bind new local variables recursively")
86    (lambda (syntax (params body |...|)) "procedure syntax")
87    (if (syntax (cond then else)) "conditional evaluation")
88    (cond (syntax (clause |...|)) "try each clause until one succeeds")
89    (case (syntax (expr clause |...|)) "look for EXPR among literal lists")
90    (delay (syntax (expr)) "create a promise to evaluate EXPR")
91    (and (syntax (expr |...|)) "evaluate EXPRs while true, return last")
92    (or (syntax (expr |...|)) "return the first true EXPR")
93    (begin (syntax (expr |...|)) "evaluate each EXPR in turn and return the last")
94    (do (syntax (vars finish body |...|)) "simple iterator")
95    (quote (syntax (expr)) "represent EXPR literally without evaluating it")
96    (quasiquote (syntax (expr)) "quote literals allowing escapes")
97    (unquote (syntax (expr)) "escape an expression inside quasiquote")
98    (unquote-splicing (syntax (expr)) "escape and splice a list expression inside quasiquote")
99    (define-syntax (syntax (identifier body |...|) undefined) "create a macro")
100    (let-syntax (syntax (syntaxes body |...|)) "a local macro")
101    (letrec-syntax (syntax (syntaxes body |...|)) "a local macro")
102    (syntax-rules (syntax (literals clauses |...|) undefined) "simple macro language")
103    (eqv? (lambda (obj1 obj2) bool) "returns #t if OBJ1 and OBJ2 are the same object")
104    (eq? (lambda (obj1 obj2) bool) "finer grained version of EQV?")
105    (equal? (lambda (obj1 obj2) bool) "recursive equivalence")
106    (not (lambda (obj) bool) "returns #t iff OBJ is false")
107    (boolean? (lambda (obj) bool) "returns #t iff OBJ is #t or #f")
108    (number? (lambda (obj) bool) "returns #t iff OBJ is a number")
109    (complex? (lambda (obj) bool) "returns #t iff OBJ is a complex number")
110    (real? (lambda (obj) bool) "returns #t iff OBJ is a real number")
111    (rational? (lambda (obj) bool) "returns #t iff OBJ is a rational number")
112    (integer? (lambda (obj) bool) "returns #t iff OBJ is an integer")
113    (exact? (lambda (z) bool) "returns #t iff Z is exact")
114    (inexact? (lambda (z) bool) "returns #t iff Z is inexact")
115    (= (lambda (z1 z2 |...|) bool) "returns #t iff the arguments are all equal")
116    (< (lambda (x1 x2 |...|) bool) "returns #t iff the arguments are monotonically increasing")
117    (> (lambda (x1 x2 |...|) bool) "returns #t iff the arguments are monotonically decreasing")
118    (<= (lambda (x1 x2 |...|) bool) "returns #t iff the arguments are monotonically nondecreasing")
119    (>= (lambda (x1 x2 |...|) bool) "returns #t iff the arguments are monotonically nonincreasing")
120    (zero? (lambda (z) bool))
121    (positive? (lambda (x) bool))
122    (negative? (lambda (x) bool))
123    (odd? (lambda (n) bool))
124    (even? (lambda (n) bool))
125    (max (lambda (x1 x2 |...|) x) "returns the maximum of the arguments")
126    (min (lambda (x1 x2 |...|) x) "returns the minimum of the arguments")
127    (+ (lambda (z1 |...|) z))
128    (* (lambda (z1 |...|) z))
129    (- (lambda (z1 |...|) z))
130    (/ (lambda (z1 |...|) z))
131    (abs (lambda (x) x) "returns the absolute value of X")
132    (quotient (lambda (n1 n2) n) "integer division")
133    (remainder (lambda (n1 n2) n) "same sign as N1")
134    (modulo (lambda (n1 n2) n) "same sign as N2")
135    (gcd (lambda (n1 |...|) n) "greatest common divisor")
136    (lcm (lambda (n2 |...|) n) "least common multiple")
137    (numerator (lambda (rational) n))
138    (denominator (lambda (rational) n))
139    (floor (lambda (x) n) "largest integer not larger than X")
140    (ceiling (lambda (x) n) "smallest integer not smaller than X")
141    (truncate (lambda (x) n) "drop fractional part")
142    (round (lambda (x) n) "round to even (banker's rounding)")
143    (rationalize (lambda (x y) n) "rational number differing from X by at most Y")
144    (exp (lambda (z) z) "e^Z")
145    (log (lambda (z) z) "natural logarithm of Z")
146    (sin (lambda (z) z) "sine function")
147    (cos (lambda (z) z) "cosine function")
148    (tan (lambda (z) z) "tangent function")
149    (asin (lambda (z) z) "arcsine function")
150    (acos (lambda (z) z) "arccosine function")
151    (atan (lambda (z) z) "arctangent function")
152    (sqrt (lambda (z) z) "principal square root of Z")
153    (expt (lambda (z1 z2) z) "returns Z1 raised to the Z2 power")
154    (make-rectangular (lambda (x1 x2) z) "create a complex number")
155    (make-polar (lambda (x1 x2) z) "create a complex number")
156    (real-part (lambda (z) x))
157    (imag-part (lambda (z) x))
158    (magnitude (lambda (z) x))
159    (angle (lambda (z) x))
160    (exact->inexact (lambda (z) z))
161    (inexact->exact (lambda (z) z))
162    (number->string (lambda (z :optional radix) str))
163    (string->number (lambda (str :optional radix) z))
164    (pair? (lambda (obj) bool) "returns #t iff OBJ is a pair")
165    (cons (lambda (obj1 obj2) pair) "create a newly allocated pair")
166    (car (lambda (pair) obj))
167    (cdr (lambda (pair) obj))
168    (set-car! (lambda (pair obj) undefined))
169    (set-cdr! (lambda (pair obj) undefined))
170    (caar (lambda (pair) obj))
171    (cadr (lambda (pair) obj))
172    (cdar (lambda (pair) obj))
173    (cddr (lambda (pair) obj))
174    (caaar (lambda (pair) obj))
175    (caadr (lambda (pair) obj))
176    (cadar (lambda (pair) obj))
177    (caddr (lambda (pair) obj))
178    (cdaar (lambda (pair) obj))
179    (cdadr (lambda (pair) obj))
180    (cddar (lambda (pair) obj))
181    (cdddr (lambda (pair) obj))
182    (caaaar (lambda (pair) obj))
183    (caaadr (lambda (pair) obj))
184    (caadar (lambda (pair) obj))
185    (caaddr (lambda (pair) obj))
186    (cadaar (lambda (pair) obj))
187    (cadadr (lambda (pair) obj))
188    (caddar (lambda (pair) obj))
189    (cadddr (lambda (pair) obj))
190    (cdaaar (lambda (pair) obj))
191    (cdaadr (lambda (pair) obj))
192    (cdadar (lambda (pair) obj))
193    (cdaddr (lambda (pair) obj))
194    (cddaar (lambda (pair) obj))
195    (cddadr (lambda (pair) obj))
196    (cdddar (lambda (pair) obj))
197    (cddddr (lambda (pair) obj))
198    (null? (lambda (obj) bool) "returns #t iff OBJ is the empty list")
199    (list? (lambda (obj) bool) "returns #t iff OBJ is a proper list")
200    (list (lambda (obj |...|) list) "returns a newly allocated list")
201    (length (lambda (list) n))
202    (append (lambda (list |...|) list) "concatenates the list arguments")
203    (reverse (lambda (list) list))
204    (list-tail (lambda (list k) list) "returns the Kth cdr of LIST")
205    (list-ref (lambda (list k) obj) "returns the Kth element of LIST")
206    (memq (lambda (obj list)) "the sublist of LIST whose car is eq? to OBJ")
207    (memv (lambda (obj list)) "the sublist of LIST whose car is eqv? to OBJ")
208    (member (lambda (obj list)) "the sublist of LIST whose car is equal? to OBJ")
209    (assq (lambda (obj list)) "the element of LIST whose car is eq? to OBJ")
210    (assv (lambda (obj list)) "the element of LIST whose car is eqv? to OBJ")
211    (assoc (lambda (obj list)) "the element of LIST whose car is equal? to OBJ")
212    (symbol? (lambda (obj) bool) "returns #t iff OBJ is a symbol")
213    (symbol->string (lambda (symbol) str))
214    (string->symbol (lambda (str) symbol))
215    (char? (lambda (obj) bool) "returns #t iff OBJ is a character")
216    (char=? (lambda (ch1 ch2) bool))
217    (char<? (lambda (ch1 ch2) bool))
218    (char>? (lambda (ch1 ch2) bool))
219    (char<=? (lambda (ch1 ch2) bool))
220    (char>=? (lambda (ch1 ch2) bool))
221    (char-ci=? (lambda (ch1 ch2) bool))
222    (char-ci<? (lambda (ch1 ch2) bool))
223    (char-ci>? (lambda (ch1 ch2) bool))
224    (char-ci<=? (lambda (ch1 ch2) bool))
225    (char-ci>=? (lambda (ch1 ch2) bool))
226    (char-alphabetic? (lambda (ch) bool))
227    (char-numeric? (lambda (ch) bool))
228    (char-whitespace? (lambda (ch) bool))
229    (char-upper-case? (lambda (ch) bool))
230    (char-lower-case? (lambda (ch) bool))
231    (char->integer (lambda (ch) int))
232    (integer->char (lambda (int) ch))
233    (char-upcase (lambda (ch) ch))
234    (char-downcase (lambda (ch) ch))
235    (string? (lambda (obj) bool) "returns #t iff OBJ is a string")
236    (make-string (lambda (k :optional ch) str) "a new string of length k")
237    (string (lambda (ch |...|) str) "a new string made of the char arguments")
238    (string-length (lambda (str) n) "the number of characters in STR")
239    (string-ref (lambda (str i) ch) "the Ith character of STR")
240    (string-set! (lambda (str i ch) undefined) "set the Ith character of STR to CH")
241    (string=? (lambda (str1 str2) bool))
242    (string-ci=? (lambda (str1 str2) bool))
243    (string<? (lambda (str1 str2) bool))
244    (string>? (lambda (str1 str2) bool))
245    (string<=? (lambda (str1 str2) bool))
246    (string>=? (lambda (str1 str2) bool))
247    (string-ci<? (lambda (str1 str2) bool))
248    (string-ci>? (lambda (str1 str2) bool))
249    (string-ci<=? (lambda (str1 str2) bool))
250    (string-ci>=? (lambda (str1 str2) bool))
251    (substring (lambda (str start end) str))
252    (string-append (lambda (str |...|) str) "concatenate the string arguments")
253    (string->list (lambda (str) list))
254    (list->string (lambda (list) str))
255    (string-copy (lambda (str) str))
256    (string-fill! (lambda (str ch) undefined) "set every char in STR to CH")
257    (vector? (lambda (obj) bool) "returns #t iff OBJ is a vector")
258    (make-vector (lambda (len :optional fill) vec) "a new vector of K elements")
259    (vector (lambda (obj |...|) vec))
260    (vector-length (lambda (vec) n) "the number of elements in VEC")
261    (vector-ref (lambda (vec i) obj) "the Ith element of VEC")
262    (vector-set! (lambda (vec i obj) undefined) "set the Ith element of VEC to OBJ")
263    (vector->list (lambda (vec) list))
264    (list->vector (lambda (list) vec))
265    (vector-fill! (lambda (vec obj) undefined) "set every element in VEC to OBJ")
266    (procedure? (lambda (obj) bool) "returns #t iff OBJ is a procedure")
267    (apply (lambda ((lambda obj a) obj |...|) a) "procedure application")
268    (map (lambda ((lambda obj a) obj |...|) (list a)) "a new list of PROC applied to every element of LIST")
269    (for-each (lambda ((lambda obj a) obj |...|) undefined) "apply PROC to each element of LIST in order")
270    (force (lambda (promise) obj) "force the delayed value of PROMISE")
271    (call-with-current-continuation (lambda (proc) obj) "goto on steroids")
272    (values (lambda (obj |...|)) "send multiple values to the calling continuation")
273    (call-with-values (lambda (producer consumer) obj))
274    (dynamic-wind (lambda (before-thunk thunk after-thunk) obj))
275    (scheme-report-environment (lambda (int) env) "INT should be 5")
276    (null-environment (lambda (int) env) "INT should be 5")
277    (call-with-input-file (lambda (path proc) input-port))
278    (call-with-output-file (lambda (path proc) output-port))
279    (input-port? (lambda (obj) bool) "returns #t iff OBJ is an input port")
280    (output-port? (lambda (obj) bool) "returns #t iff OBJ is an output port")
281    (current-input-port (lambda () input-port) "the default input for read procedures")
282    (current-output-port (lambda () output-port) "the default output for write procedures")
283    (with-input-from-file (lambda (path thunk) obj))
284    (with-output-to-file (lambda (path thunk) obj))
285    (open-input-file (lambda (path) input-port))
286    (open-output-file (lambda (path) output-port))
287    (close-input-port (lambda (input-port)))
288    (close-output-port (lambda (output-port)))
289    (read (lambda (:optional input-port) obj) "read a datum")
290    (read-char (lambda (:optional input-port) ch) "read a single character")
291    (peek-char (lambda (:optional input-port) ch))
292    (eof-object? (lambda (obj) bool) "returns #t iff OBJ is the end-of-file object")
293    (char-ready? (lambda (:optional input-port) bool))
294    (write (lambda (object :optional output-port) undefined) "write a datum")
295    (display (lambda (object :optional output-port) undefined) "display")
296    (newline (lambda (:optional output-port) undefined) "send a linefeed")
297    (write-char (lambda (char :optional output-port) undefined) "write a single character")
298    (load (lambda (filename) undefined) "evaluate expressions from a file")
299    (eval (lambda (expr env)))
300  ))
301
302(defvar *scheme-srfi-info*
303  [
304   ;; SRFI 0
305   ("Feature-based conditional expansion construct"
306    (cond-expand (syntax (clause |...|))))
307   
308   ;; SRFI 1
309   ("List Library"
310    (xcons (lambda (object object) pair))
311    (cons* (lambda (object |...|) pair))
312    (make-list (lambda (integer :optional object) list))
313    (list-tabulate (lambda (integer procedure) list))
314    (list-copy (lambda (list) list))
315    (circular-list (lambda (object |...|) list))
316    (iota (lambda (integer :optional integer integer) list))
317    (proper-list? (lambda (object) bool))
318    (circular-list? (lambda (object) bool))
319    (dotted-list? (lambda (object) bool))
320    (not-pair? (lambda (object) bool))
321    (null-list? (lambda (object) bool))
322    (list= (lambda (procedure list |...|) bool))
323    (first (lambda (pair)))
324    (second (lambda (pair)))
325    (third (lambda (pair)))
326    (fourth (lambda (pair)))
327    (fifth (lambda (pair)))
328    (sixth (lambda (pair)))
329    (seventh (lambda (pair)))
330    (eighth (lambda (pair)))
331    (ninth (lambda (pair)))
332    (tenth (lambda (pair)))
333    (car+cdr (lambda (pair)))
334    (take (lambda (pair integer) list))
335    (drop (lambda (pair integer) list))
336    (take-right (lambda (pair integer) list))
337    (drop-right (lambda (pair integer) list))
338    (take! (lambda (pair integer) list))
339    (drop-right! (lambda (pair integer) list))
340    (split-at (lambda (pair integer) list))
341    (split-at! (lambda (pair integer) list))
342    (last (lambda (pair) obj))
343    (last-pair (lambda (pair) pair))
344    (length+ (lambda (object) n))
345    (concatenate (lambda (list) list))
346    (append! (lambda (list |...|) list))
347    (concatenate! (lambda (list) list))
348    (reverse! (lambda (list) list))
349    (append-reverse (lambda (list list) list))
350    (append-reverse! (lambda (list list) list))
351    (zip (lambda (list |...|) list))
352    (unzip1 (lambda (list) list))
353    (unzip2 (lambda (list) list))
354    (unzip3 (lambda (list) list))
355    (unzip4 (lambda (list) list))
356    (unzip5 (lambda (list) list))
357    (count (lambda (procedure list |...|) n))
358    (fold (lambda ((lambda obj a) object list |...|) a))
359    (unfold (lambda (procedure procedure procedure object :optional procedure) obj))
360    (pair-fold (lambda ((lambda obj a) object list |...|) a))
361    (reduce (lambda ((lambda obj a) object list |...|) a))
362    (fold-right (lambda ((lambda obj a) object list |...|) a))
363    (unfold-right (lambda (procedure procedure procedure object :optional object) obj))
364    (pair-fold-right (lambda ((lambda obj a) object list |...|) a))
365    (reduce-right (lambda ((lambda obj a) object list |...|) a))
366    (append-map (lambda (procedure list |...|) list))
367    (append-map! (lambda (procedure list |...|) list))
368    (map! (lambda (procedure list |...|) list))
369    (pair-for-each (lambda (procedure list |...|) undefined))
370    (filter-map (lambda (procedure list |...|) list))
371    (map-in-order (lambda (procedure list |...|) list))
372    (filter (lambda (procedure list) list))
373    (partition (lambda (procedure list) list))
374    (remove (lambda (procedure list) list))
375    (filter! (lambda (procedure list) list))
376    (partition! (lambda (procedure list) list))
377    (remove! (lambda (procedure list) list))
378    (find (lambda (procedure list) obj))
379    (find-tail (lambda (procedure list) obj))
380    (any (lambda ((lambda obj a) list |...|) a))
381    (every (lambda ((lambda obj a) list |...|) a))
382    (list-index (lambda (procedure list |...|) (or bool integer)))
383    (take-while (lambda (procedure list) list))
384    (drop-while (lambda (procedure list) list))
385    (take-while! (lambda (procedure list) list))
386    (span (lambda (procedure list) list))
387    (break (lambda (procedure list) list))
388    (span! (lambda (procedure list) list))
389    (break! (lambda (procedure list) list))
390    (delete (lambda (object list :optional procedure) list))
391    (delete-duplicates (lambda (list :optional procedure) list))
392    (delete! (lambda (obj list :optional procedure) list))
393    (delete-duplicates! (lambda (list :optional procedure) list))
394    (alist-cons (lambda (obj1 obj2 alist) alist))
395    (alist-copy (lambda (alist) alist))
396    (alist-delete (lambda (obj alist) alist))
397    (alist-delete! (lambda (obj alist) alist))
398    (lset<= (lambda (procedure list |...|) bool))
399    (lset= (lambda (procedure list |...|) bool))
400    (lset-adjoin (lambda (procedure list object |...|) list))
401    (lset-union (lambda (procedure list |...|) list))
402    (lset-union! (lambda (procedure list |...|) list))
403    (lset-intersection (lambda (procedure list |...|) list))
404    (lset-intersection! (lambda (procedure list |...|) list))
405    (lset-difference (lambda (procedure list |...|) list))
406    (lset-difference! (lambda (procedure list |...|) list))
407    (lset-xor (lambda (procedure list |...|) list))
408    (lset-xor! (lambda (procedure list |...|) list))
409    (lset-diff+intersection (lambda (procedure list |...|) list))
410    (lset-diff+intersection! (lambda (procedure list |...|) list))
411
412    )
413
414   ;; SRFI 2
415   ("AND-LET*: an AND with local bindings, a guarded LET* special form"
416    (and-let* (syntax (bindings body |...|))))
417
418   ()
419
420   ;; SRFI 4
421   ("Homogeneous numeric vector datatypes"
422
423    (u8vector? (lambda (obj) bool))
424    (make-u8vector (lambda (size integer) u8vector))
425    (u8vector (lambda (integer |...|) u8vector))
426    (u8vector-length (lambda (u8vector) n))
427    (u8vector-ref (lambda (u8vector i) int))
428    (u8vector-set! (lambda (u8vector i u8value) undefined))
429    (u8vector->list (lambda (u8vector) list))
430    (list->u8vector (lambda (list) u8vector))
431
432    (s8vector? (lambda (obj) bool))
433    (make-s8vector (lambda (size integer) s8vector))
434    (s8vector (lambda (integer |...|) s8vector))
435    (s8vector-length (lambda (s8vector) n))
436    (s8vector-ref (lambda (s8vector i) int))
437    (s8vector-set! (lambda (s8vector i s8value) undefined))
438    (s8vector->list (lambda (s8vector) list))
439    (list->s8vector (lambda (list) s8vector))
440
441    (u16vector? (lambda (obj) bool))
442    (make-u16vector (lambda (size integer) u16vector))
443    (u16vector (lambda (integer |...|)))
444    (u16vector-length (lambda (u16vector) n))
445    (u16vector-ref (lambda (u16vector i) int))
446    (u16vector-set! (lambda (u16vector i u16value) undefined))
447    (u16vector->list (lambda (u16vector) list))
448    (list->u16vector (lambda (list) u16vector))
449
450    (s16vector? (lambda (obj) bool))
451    (make-s16vector (lambda (size integer) s16vector))
452    (s16vector (lambda (integer |...|) s16vector))
453    (s16vector-length (lambda (s16vector) n))
454    (s16vector-ref (lambda (s16vector i) int))
455    (s16vector-set! (lambda (s16vector i s16value) undefined))
456    (s16vector->list (lambda (s16vector) list))
457    (list->s16vector (lambda (list) s16vector))
458
459    (u32vector? (lambda (obj) bool))
460    (make-u32vector (lambda (size integer) u32vector))
461    (u32vector (lambda (integer |...|) u32vector))
462    (u32vector-length (lambda (u32vector) n))
463    (u32vector-ref (lambda (u32vector i) int))
464    (u32vector-set! (lambda (u32vector i u32value) undefined))
465    (u32vector->list (lambda (u32vector) list))
466    (list->u32vector (lambda (list) u32vector))
467
468    (s32vector? (lambda (obj) bool))
469    (make-s32vector (lambda (size integer) s32vector))
470    (s32vector (lambda (integer |...|) s32vector))
471    (s32vector-length (lambda (s32vector) n))
472    (s32vector-ref (lambda (s32vector i) int))
473    (s32vector-set! (lambda (s32vector i s32value) undefined))
474    (s32vector->list (lambda (s32vector) list))
475    (list->s32vector (lambda (list) s32vector))
476
477    (u64vector? (lambda (obj) bool))
478    (make-u64vector (lambda (size integer) u64vector))
479    (u64vector (lambda (integer |...|) u64vector))
480    (u64vector-length (lambda (u64vector) n))
481    (u64vector-ref (lambda (u64vector i) int))
482    (u64vector-set! (lambda (u64vector i u64value) undefined))
483    (u64vector->list (lambda (u64vector) list))
484    (list->u64vector (lambda (list) u64vector))
485
486    (s64vector? (lambda (obj) bool))
487    (make-s64vector (lambda (size integer) s64vector))
488    (s64vector (lambda (integer |...|) s64vector))
489    (s64vector-length (lambda (s64vector) n))
490    (s64vector-ref (lambda (s64vector i) int))
491    (s64vector-set! (lambda (s64vector i s64value) undefined))
492    (s64vector->list (lambda (s64vector) list))
493    (list->s64vector (lambda (list) s64vector))
494
495    (f32vector? (lambda (obj) bool))
496    (make-f32vector (lambda (size integer) f32vector))
497    (f32vector (lambda (number |...|) f32vector))
498    (f32vector-length (lambda (f32vector) n))
499    (f32vector-ref (lambda (f32vector i) int))
500    (f32vector-set! (lambda (f32vector i f32value) undefined))
501    (f32vector->list (lambda (f32vector) list))
502    (list->f32vector (lambda (list) f32vector))
503
504    (f64vector? (lambda (obj) bool))
505    (make-f64vector (lambda (size integer) f64vector))
506    (f64vector (lambda (number |...|) f64vector))
507    (f64vector-length (lambda (f64vector) n))
508    (f64vector-ref (lambda (f64vector i) int))
509    (f64vector-set! (lambda (f64vector i f64value) undefined))
510    (f64vector->list (lambda (f64vector) list))
511    (list->f64vector (lambda (list) f64vector))
512    )
513
514   ;; SRFI 5
515   ("A compatible let form with signatures and rest arguments"
516    (let (syntax (bindings body |...|))))
517
518   ;; SRFI 6
519   ("Basic String Ports"
520    (open-input-string (lambda (str) input-port))
521    (open-output-string (lambda () output-port))
522    (get-output-string (lambda (output-port) str)))
523
524   ;; SRFI 7
525   ("Feature-based program configuration language"
526    (program (syntax (clause |...|)))
527    (feature-cond (syntax (clause))))
528
529   ;; SRFI 8
530   ("receive: Binding to multiple values"
531    (receive (syntax (identifiers producer body |...|))))
532
533   ;; SRFI 9
534   ("Defining Record Types"
535    (define-record-type (syntax (name constructor-name pred-name fields |...|))))
536
537   ;; SRFI 10
538   ("Sharp-Comma External Form"
539    (define-reader-ctor (syntax (name proc) undefined)))
540
541   ;; SRFI 11
542   ("Syntax for receiving multiple values"
543    (let-values (syntax (bindings body |...|)))
544    (let-values* (syntax (bindings body |...|))))
545
546   ()
547
548   ;; SRFI 13
549   ("String Library"
550    (string-map (lambda (proc str :optional start end) str))
551    (string-map! (lambda (proc str :optional start end) undefined))
552    (string-fold (lambda (kons knil str :optional start end) obj))
553    (string-fold-right (lambda (kons knil str :optional start end) obj))
554    (string-unfold (lambda (p f g seed :optional base make-final) str))
555    (string-unfold-right (lambda (p f g seed :optional base make-final) str))
556    (string-tabulate (lambda (proc len) str))
557    (string-for-each (lambda (proc str :optional start end) undefined))
558    (string-for-each-index (lambda (proc str :optional start end) undefined))
559    (string-every (lambda (pred str :optional start end) obj))
560    (string-any (lambda (pred str :optional start end) obj))
561    (string-hash (lambda (str :optional bound start end) int))
562    (string-hash-ci (lambda (str :optional bound start end) int))
563    (string-compare (lambda (string1 string2 lt-proc eq-proc gt-proc :optional start end) obj))
564    (string-compare-ci (lambda (string1 string2 lt-proc eq-proc gt-proc :optional start end) obj))
565    (string= (lambda (string1 string2 :optional start1 end1 start2 end2) bool))
566    (string<> (lambda (string1 string2 :optional start1 end1 start2 end2) bool))
567    (string< (lambda (string1 string2 :optional start1 end1 start2 end2) bool))
568    (string> (lambda (string1 string2 :optional start1 end1 start2 end2) bool))
569    (string<= (lambda (string1 string2 :optional start1 end1 start2 end2) bool))
570    (string>= (lambda (string1 string2 :optional start1 end1 start2 end2) bool))
571    (string-ci= (lambda (string1 string2 :optional start1 end1 start2 end2) bool))
572    (string-ci<> (lambda (string1 string2 :optional start1 end1 start2 end2) bool))
573    (string-ci< (lambda (string1 string2 :optional start1 end1 start2 end2) bool))
574    (string-ci> (lambda (string1 string2 :optional start1 end1 start2 end2) bool))
575    (string-ci<= (lambda (string1 string2 :optional start1 end1 start2 end2) bool))
576    (string-ci>= (lambda (string1 string2 :optional start1 end1 start2 end2) bool))
577    (string-titlecase (lambda (string :optional start end) str))
578    (string-upcase (lambda (string :optional start end) str))
579    (string-downcase (lambda (string :optional start end) str))
580    (string-titlecase! (lambda (string :optional start end) undefined))
581    (string-upcase! (lambda (string :optional start end) undefined))
582    (string-downcase! (lambda (string :optional start end) undefined))
583    (string-take (lambda (string nchars) str))
584    (string-drop (lambda (string nchars) str))
585    (string-take-right (lambda (string nchars) str))
586    (string-drop-right (lambda (string nchars) str))
587    (string-pad (lambda (string k :optional char start end) str))
588    (string-pad-right (lambda (string k :optional char start end) str))
589    (string-trim (lambda (string :optional char/char-set/pred start end) str))
590    (string-trim-right (lambda (string :optional char/char-set/pred start end) str))
591    (string-trim-both (lambda (string :optional char/char-set/pred start end) str))
592    (string-filter (lambda (char/char-set/pred string :optional start end) str))
593    (string-delete (lambda (char/char-set/pred string :optional start end) str))
594    (string-index (lambda (string char/char-set/pred :optional start end) (or integer bool)))
595    (string-index-right (lambda (string char/char-set/pred :optional end start) (or integer bool)))
596    (string-skip (lambda (string char/char-set/pred :optional start end) (or integer bool)))
597    (string-skip-right (lambda (string char/char-set/pred :optional end start) (or integer bool)))
598    (string-count (lambda (string char/char-set/pred :optional start end) n))
599    (string-prefix-length (lambda (string1 string2 :optional start1 end1 start2 end2) n))
600    (string-suffix-length (lambda (string1 string2 :optional start1 end1 start2 end2) n))
601    (string-prefix-length-ci (lambda (string1 string2 :optional start1 end1 start2 end2) n))
602    (string-suffix-length-ci (lambda (string1 string2 :optional start1 end1 start2 end2) n))
603    (string-prefix? (lambda (string1 string2 :optional start1 end1 start2 end2) bool))
604    (string-suffix? (lambda (string1 string2 :optional start1 end1 start2 end2) bool))
605    (string-prefix-ci? (lambda (string1 string2 :optional start1 end1 start2 end2) bool))
606    (string-suffix-ci? (lambda (string1 string2 :optional start1 end1 start2 end2) bool))
607    (string-contains (lambda (string pattern :optional s-start s-end p-start p-end) obj))
608    (string-contains-ci (lambda (string pattern :optional s-start s-end p-start p-end) obj))
609    (string-fill! (lambda (string char :optional start end) undefined))
610    (string-copy! (lambda (to tstart from :optional fstart fend) undefined))
611    (string-copy (lambda (str :optional start end) str))
612    (substring/shared (lambda (str start :optional end) str))
613    (string-reverse (lambda (str :optional start end) str))
614    (string-reverse! (lambda (str :optional start end) undefined))
615    (reverse-list->string (lambda (char-list) str))
616    (string->list (lambda (str :optional start end) list))
617    (string-concatenate (lambda (string-list) str))
618    (string-concatenate/shared (lambda (string-list) str))
619    (string-append/shared (lambda (str |...|) str))
620    (string-concatenate-reverse (lambda (string-list :optional final-string end) str))
621    (string-concatenate-reverse/shared (lambda (string-list :optional final-string end) str))
622    (xsubstring (lambda (str from :optional to start end) str))
623    (string-xcopy! (lambda (target tstart str from :optional to start end) undefined))
624    (string-null? (lambda (str) bool))
625    (string-join (lambda (string-list :optional delim grammar) str))
626    (string-tokenize (lambda (string :optional token-chars start end) str))
627    (string-replace (lambda (str1 str2 start1 end1 :optional start2 end2) str))
628    (string-kmp-partial-search (lambda (pat rv str i :optional c= p-start s-start s-end) n))
629    (make-kmp-restart-vector (lambda (str :optional c= start end) vec))
630    (kmp-step (lambda (pat rv c i c= p-start) n))
631    )
632
633   ;; SRFI 14
634   ("Character-Set Library"
635    (char-set? (lambda (cset) bool))
636    (char-set= (lambda (cset |...|) bool))
637    (char-set<= (lambda (cset |...|) bool))
638    (char-set-hash (lambda (cset :optional int) int))
639    (char-set-cursor (lambda (cset) cursor))
640    (char-set-ref (lambda (cset cursor) ch))
641    (char-set-cursor-next (lambda (cset cursor) int))
642    (end-of-char-set? (lambda (cursor) bool))
643    (char-set-fold (lambda (proc obj cset) obj))
644    (char-set-unfold (lambda (proc proc proc obj :optional obj) cset))
645    (char-set-unfold! (lambda (proc proc proc obj obj) cset))
646    (char-set-for-each (lambda (proc cset) undefined))
647    (char-set-map (lambda (proc cset) cset))
648    (char-set-copy (lambda (cset) cset))
649    (char-set (lambda (ch |...|) cset))
650    (list->char-set (lambda (list :optional obj) cset))
651    (list->char-set! (lambda (list cset) cset))
652    (string->char-set (lambda (str :optional cset) cset))
653    (string->char-set! (lambda (str cset) cset))
654    (ucs-range->char-set (lambda (int int :optional bool cset) cset))
655    (ucs-range->char-set! (lambda (int int bool cset) cset))
656    (char-set-filter (lambda (proc cset :optional base-cset) cset))
657    (char-set-filter! (lambda (proc cset base-cset) cset))
658    (->char-set (lambda (obj) cset))
659    (char-set-size (lambda (cset) n))
660    (char-set-count (lambda (proc cset) n))
661    (char-set-contains? (lambda (cset ch) bool))
662    (char-set-every (lambda (proc cset) obj))
663    (char-set-any (lambda (proc cset) obj))
664    (char-set-adjoin (lambda (cset ch |...|) cset))
665    (char-set-delete (lambda (cset ch |...|) cset))
666    (char-set-adjoin! (lambda (cset ch |...|) cset))
667    (char-set-delete! (lambda (cset ch |...|) cset))
668    (char-set->list (lambda (cset) list))
669    (char-set->string (lambda (cset) str))
670    (char-set-complement (lambda (cset) cset))
671    (char-set-union (lambda (cset |...|) cset))
672    (char-set-intersection (lambda (cset |...|) cset))
673    (char-set-xor (lambda (cset |...|) cset))
674    (char-set-difference (lambda (cset |...|) cset))
675    (char-set-diff+intersection (lambda (cset |...|) cset))
676    (char-set-complement! (lambda (cset) cset))
677    (char-set-union! (lambda (cset |...|) cset))
678    (char-set-intersection! (lambda (cset |...|) cset))
679    (char-set-xor! (lambda (cset |...|) cset))
680    (char-set-difference! (lambda (cset |...|) cset))
681    (char-set-diff+intersection! (lambda (cset |...|) cset))
682    (char-set:lower-case char-set)
683    (char-set:upper-case char-set)
684    (char-set:letter char-set)
685    (char-set:digit char-set)
686    (char-set:letter+digit char-set)
687    (char-set:graphic char-set)
688    (char-set:printing char-set)
689    (char-set:whitespace char-set)
690    (char-set:blank char-set)
691    (char-set:iso-control char-set)
692    (char-set:punctuation char-set)
693    (char-set:symbol char-set)
694    (char-set:hex-digit char-set)
695    (char-set:ascii char-set)
696    (char-set:empty char-set)
697    (char-set:full char-set)
698    )
699
700   ()
701
702   ;; SRFI 16
703   ("Syntax for procedures of variable arity"
704    (case-lambda (syntax (clauses |...|) procedure)))
705
706   ;; SRFI 17
707   ("Generalized set!"
708    (set! (syntax (what value) undefined)))
709
710   ;; SRFI 18
711   ("Multithreading support"
712    (current-thread (lambda () thread))
713    (thread? (lambda (obj) bool))
714    (make-thread (lambda (thunk :optional name) thread))
715    (thread-name (lambda (thread) name))
716    (thread-specific (lambda (thread)))
717    (thread-specific-set! (lambda (thread obj)))
718    (thread-base-priority (lambda (thread)))
719    (thread-base-priority-set! (lambda (thread number)))
720    (thread-priority-boost (lambda (thread)))
721    (thread-priority-boost-set! (lambda (thread number)))
722    (thread-quantum (lambda (thread)))
723    (thread-quantum-set! (lambda (thread number)))
724    (thread-start! (lambda (thread)))
725    (thread-yield! (lambda ()))
726    (thread-sleep! (lambda (number)))
727    (thread-terminate! (lambda (thread)))
728    (thread-join! (lambda (thread :optional timeout timeout-val)))
729    (mutex? (lambda (obj) bool))
730    (make-mutex (lambda (:optional name) mutex))
731    (mutex-name (lambda (mutex) name))
732    (mutex-specific (lambda (mutex)))
733    (mutex-specific-set! (lambda (mutex obj)))
734    (mutex-state (lambda (mutex)))
735    (mutex-lock! (lambda (mutex :optional timeout thread)))
736    (mutex-unlock! (lambda (mutex :optional condition-variable timeout)))
737    (condition-variable? (lambda (obj) bool))
738    (make-condition-variable (lambda (:optional name) condition-variable))
739    (condition-variable-name (lambda (condition-variable) name))
740    (condition-variable-specific (lambda (condition-variable)))
741    (condition-variable-specific-set! (lambda (condition-variable obj)))
742    (condition-variable-signal! (lambda (condition-variable)))
743    (condition-variable-broadcast! (lambda (condition-variable)))
744    (current-time (lambda () time))
745    (time? (lambda (obj) bool))
746    (time->seconds (lambda (time) x))
747    (seconds->time (lambda (x) time))
748    (current-exception-handler (lambda () handler))
749    (with-exception-handler (lambda (handler thunk)))
750    (raise (lambda (obj)))
751    (join-timeout-exception? (lambda (obj) bool))
752    (abandoned-mutex-exception? (lambda (obj) bool))
753    (terminated-thread-exception? (lambda (obj) bool))
754    (uncaught-exception? (lambda (obj) bool))
755    (uncaught-exception-reason (lambda (exc) obj))
756    )
757
758   ;; SRFI 19
759   ("Time Data Types and Procedures"
760    (current-date (lambda (:optional tz-offset)) date)
761    (current-julian-day (lambda ()) jdn)
762    (current-modified-julian-day (lambda ()) mjdn)
763    (current-time (lambda (:optional time-type)) time)
764    (time-resolution (lambda (:optional time-type)) nanoseconds)
765    (make-time (lambda (type nanosecond second)))
766    (time? (lambda (obj)))
767    (time-type (lambda (time)))
768    (time-nanosecond (lambda (time)))
769    (time-second (lambda (time)))
770    (set-time-type! (lambda (time)))
771    (set-time-nanosecond! (lambda (time)))
772    (set-time-second! (lambda (time)))
773    (copy-time (lambda (time)))
774    (time<=? (lambda (time1 time2)))
775    (time<? (lambda (time1 time2)))
776    (time=? (lambda (time1 time2)))
777    (time>=? (lambda (time1 time2)))
778    (time>? (lambda (time1 time2)))
779    (time-difference (lambda (time1 time2)))
780    (time-difference! (lambda (time1 time2)))
781    (add-duration (lambda (time duration)))
782    (add-duration! (lambda (time duration)))
783    (subtract-duration (lambda (time duration)))
784    (subtract-duration! (lambda (time duration)))
785    (make-date (lambda (nanosecond second minute hour day month year zone-offset)))
786    (date? (lambda (obj)))
787    (date-nanosecond (lambda (date)))
788    (date-second (lambda (date)))
789    (date-minute (lambda (date)))
790    (date-hour (lambda (date)))
791    (date-day (lambda (date)))
792    (date-month (lambda (date)))
793    (date-year (lambda (date)))
794    (date-zone-offset (lambda (date)))
795    (date-year-day (lambda (date)))
796    (date-week-day (lambda (date)))
797    (date-week-number (lambda (date)))
798    (date->julian-day (lambda (date)))
799    (date->modified-julian-day (lambda (date)))
800    (date->time-monotonic (lambda (date)))
801    (date->time-tai (lambda (date)))
802    (date->time-utc (lambda (date)))
803    (julian-day->date (lambda (date)))
804    (julian-day->time-monotonic (lambda (date)))
805    (julian-day->time-tai (lambda (date)))
806    (julian-day->time-utc (lambda (date)))
807    (modified-julian-day->date (lambda (date)))
808    (modified-julian-day->time-monotonic (lambda (date)))
809    (modified-julian-day->time-tai (lambda (date)))
810    (modified-julian-day->time-utc (lambda (date)))
811    (time-monotonic->date (lambda (date)))
812    (time-monotonic->julian-day (lambda (date)))
813    (time-monotonic->modified-julian-day (lambda (date)))
814    (time-monotonic->time-monotonic (lambda (date)))
815    (time-monotonic->time-tai (lambda (date)))
816    (time-monotonic->time-tai! (lambda (date)))
817    (time-monotonic->time-utc (lambda (date)))
818    (time-monotonic->time-utc! (lambda (date)))
819    (time-tai->date (lambda (date)))
820    (time-tai->julian-day (lambda (date)))
821    (time-tai->modified-julian-day (lambda (date)))
822    (time-tai->time-monotonic (lambda (date)))
823    (time-tai->time-monotonic! (lambda (date)))
824    (time-tai->time-utc (lambda (date)))
825    (time-tai->time-utc! (lambda (date)))
826    (time-utc->date (lambda (date)))
827    (time-utc->julian-day (lambda (date)))
828    (time-utc->modified-julian-day (lambda (date)))
829    (time-utc->time-monotonic (lambda (date)))
830    (time-utc->time-monotonic! (lambda (date)))
831    (time-utc->time-tai (lambda (date)))
832    (time-utc->time-tai! (lambda (date)))
833    (date->string (lambda (date :optional format-string)))
834    (string->date (lambda (input-string template-string)))
835    )
836
837   ()
838
839   ;; SRFI 21
840   ("Real-time multithreading support"
841    srfi-18)                            ; same as srfi-18
842
843   ;; SRFI 22
844   ("Running Scheme Scripts on Unix"
845    )
846
847   ;; SRFI 23
848   ("Error reporting mechanism"
849    (error (lambda (reason-string arg |...|))))
850
851   ()
852
853   ;; SRFI 25
854   ("Multi-dimensional Array Primitives"
855    (array? (lambda (obj)))
856    (make-array (lambda (shape :optional init)))
857    (shape (lambda (bound |...|)))
858    (array (lambda (shape obj |...|)))
859    (array-rank (lambda (array)))
860    (array-start (lambda (array)))
861    (array-end (lambda (array)))
862    (array-shape (lambda (array)))
863    (array-ref (lambda (array i |...|)))
864    (array-set! (lambda (array obj |...|) undefined))
865    (share-array (lambda (array shape proc)))
866    )
867
868   ;; SRFI 26
869   ("Notation for Specializing Parameters without Currying"
870    (cut (syntax (obj |...|)))
871    (cute (lambda (obj |...|))))
872
873   ;; SRFI 27
874   ("Sources of Random Bits"
875    (random-integer (lambda (n)))
876    (random-real (lambda ()))
877    (default-random-source (lambda ()))
878    (make-random-source (lambda ()))
879    (random-source? (lambda (obj)))
880    (random-source-state-ref (lambda (random-source)))
881    (random-source-state-set! (lambda (random-source state)))
882    (random-source-randomize! (lambda (random-source)))
883    (random-source-pseudo-randomize! (lambda (random-source i j)))
884    (random-source-make-integers (lambda (random-source)))
885    (random-source-make-reals (lambda (random-source)))
886    )
887
888   ;; SRFI 28
889   ("Basic Format Strings"
890    (format (lambda (port-or-boolean format-string arg |...|))))
891
892   ;; SRFI 29
893   ("Localization"
894    (current-language (lambda (:optional symbol)))
895    (current-country (lambda (:optional symbol)))
896    (current-locale-details (lambda (:optional list)))
897    (declare-bundle! (lambda (bundle-name association-list)))
898    (store-bundle (lambda (bundle-name)))
899    (load-bundle! (lambda (bundle-name)))
900    (localized-template (lambda (package-name message-template-name)))
901    )
902
903   ;; SRFI 30
904   ("Nested Multi-line Comments"
905    )
906
907   ;; SRFI 31
908   ("A special form for recursive evaluation"
909    (rec (syntax (name body |...|) procedure)))
910
911   ()
912
913   ()
914
915   ;; SRFI 34
916   ("Exception Handling for Programs"
917    (guard (syntax (clauses |...|)))
918    (raise (lambda (obj)))
919    )
920
921   ;; SRFI 35
922   ("Conditions"
923    (make-condition-type (lambda (id parent field-name-list)))
924    (condition-type? (lambda (obj)))
925    (make-condition (lambda (condition-type)))
926    (condition? (lambda (obj)))
927    (condition-has-type? (lambda (condition condition-type)))
928    (condition-ref (lambda (condition field-name)))
929    (make-compound-condition (lambda (condition |...|)))
930    (extract-condition (lambda (condition condition-type)))
931    (define-condition-type (syntax (name parent pred-name fields |...|)))
932    (condition (syntax (type-field-binding |...|)))
933    )
934
935   ;; SRFI 36
936   ("I/O Conditions"
937    (&error condition)
938    (&i/o-error condition)
939    (&i/o-port-error condition)
940    (&i/o-read-error condition)
941    (&i/o-write-error condition)
942    (&i/o-closed-error condition)
943    (&i/o-filename-error condition)
944    (&i/o-malformed-filename-error condition)
945    (&i/o-file-protection-error condition)
946    (&i/o-file-is-read-only-error condition)
947    (&i/o-file-already-exists-error condition)
948    (&i/o-no-such-file-error condition)
949    )
950
951   ;; SRFI 37
952   ("args-fold: a program argument processor"
953    (args-fold
954     (arg-list option-list unrecognized-option-proc operand-proc seed |...|))
955    (option-processor (lambda (option name arg seeds |...|)))
956    (operand-processor (lambda (operand seeds |...|)))
957    (option (lambda (name-list required-arg? optional-arg? option-proc)))
958    (option-names (lambda (option)))
959    (option-required-arg? (lambda (option)))
960    (option-optional-arg? (lambda (option)))
961    (option-processor (lambda (option)))
962    )
963
964   ;; SRFI 38
965   ("External Representation for Data With Shared Structure"
966    (write-with-shared-structure (lambda (obj :optional port optarg)))
967    (read-with-shared-structure (lambda (:optional port)))
968    )
969
970   ;; SRFI 39
971   ("Parameter objects"
972    (make-parameter (lambda (init-value :optional converter)))
973    (parameterize (syntax (bindings body |...|))))
974
975   ;; SRFI 40
976   ("A Library of Streams"
977    (stream-null stream)
978    (stream-cons (syntax (obj stream)))
979    (stream? (lambda (obj)))
980    (stream-null? (lambda (obj)))
981    (stream-pair? (lambda (obj)))
982    (stream-car (lambda (stream)))
983    (stream-cdr (lambda (stream)))
984    (stream-delay (syntax (expr)))
985    (stream (lambda (obj |...|)))
986    (stream-unfoldn (lambda (generator-proc seed n)))
987    (stream-map (lambda (proc stream |...|)))
988    (stream-for-each (lambda (proc stream |...|) undefined))
989    (stream-filter (lambda (pred stream)))
990    )
991
992   ()
993
994   ;; SRFI 42
995   ("Eager Comprehensions"
996    (list-ec (syntax))
997    (append-ec (syntax))
998    (sum-ec (syntax))
999    (min-ec (syntax))
1000    (max-ec (syntax))
1001    (any?-ec (syntax))
1002    (every?-ec (syntax))
1003    (first-ec (syntax))
1004    (do-ec (syntax))
1005    (fold-ec (syntax))
1006    (fold3-ec (syntax))
1007    (:list (syntax () undefined))
1008    (:string (syntax () undefined))
1009    (:vector (syntax () undefined))
1010    (:integers (syntax () undefined))
1011    (:range (syntax () undefined))
1012    (:real-range (syntax () undefined))
1013    (:char-range (syntax () undefined))
1014    (:port (syntax () undefined))
1015    (:do (syntax () undefined))
1016    (:let (syntax () undefined))
1017    (:parallel (syntax () undefined))
1018    (:while (syntax () undefined))
1019    (:until (syntax () undefined))
1020    )
1021
1022   ;; SRFI 43
1023   ("Vector Library"
1024    (vector-unfold (f length initial-seed |...|))
1025    (vector-unfold-right (lambda (f length initial-seed |...|)))
1026    (vector-tabulate (lambda (f size)))
1027    (vector-copy (lambda (vec :optional start end fill)))
1028    (vector-reverse-copy (lambda (vec :optional start end)))
1029    (vector-append (lambda (vec |...|)))
1030    (vector-concatenate (lambda (vector-list)))
1031    (vector-empty? (lambda (obj)))
1032    (vector= (lambda (eq-proc vec |...|)))
1033    (vector-fold (lambda (kons knil vec |...|)))
1034    (vector-fold-right (lambda (kons knil vec |...|)))
1035    (vector-map (lambda (f vec |...|)))
1036    (vector-map! (lambda (f vec |...|)))
1037    (vector-for-each (lambda (f vec |...|) undefined))
1038    (vector-count (lambda (pred vec |...|)))
1039    (vector-index (lambda (pred vec |...|)))
1040    (vector-index-right (lambda (pred vec |...|)))
1041    (vector-skip (lambda (pred vec |...|)))
1042    (vector-skip-right (lambda (pred vec |...|)))
1043    (vector-binary-search (lambda (vec value cmp-proc)))
1044    (vector-any (lambda (pred vec |...|)))
1045    (vector-every (lambda (pred vec |...|)))
1046    (vector-swap! (lambda (vec i j) undefined))
1047    (vector-reverse! (lambda (vec :optional start end) undefined))
1048    (vector-copy! (lambda (target-vec t-start source-vec :optional start end) undefined))
1049    (vector-reverse-copy! (lambda (target-vec t-start source-vec :optional start end) undefined))
1050    (reverse-vector-to-list (lambda (vec :optional start end)))
1051    (reverse-list-to-vector (lambda (list)))
1052    )
1053
1054   ;; SRFI 44
1055   ("Collections"
1056    )
1057
1058   ;; SRFI 45
1059   ("Primitives for expressing iterative lazy algorithms"
1060    (delay (syntax (expr)))
1061    (lazy (syntax (expr)))
1062    (force (lambda (promise)))
1063    (eager (lambda (promise)))
1064    )
1065
1066   ;; SRFI 46
1067   ("Basic Syntax-rules Extensions"
1068    (syntax-rules (syntax () undefined)))
1069
1070   ;; SRFI 47
1071   ("Array"
1072    (make-array (lambda (prototype k |...|)))
1073    (ac64 (lambda (:optional z)))
1074    (ac32 (lambda (:optional z)))
1075    (ar64 (lambda (:optional x)))
1076    (ar32 (lambda (:optional x)))
1077    (as64 (lambda (:optional n)))
1078    (as32 (lambda (:optional n)))
1079    (as16 (lambda (:optional n)))
1080    (as8 (lambda (:optional n)))
1081    (au64 (lambda (:optional n)))
1082    (au32 (lambda (:optional n)))
1083    (au16 (lambda (:optional n)))
1084    (au8 (lambda (:optional n)))
1085    (at1 (lambda (:optional bool)))
1086    (make-shared-array (lambda (array mapper k |...|)))
1087    (array-rank (lambda (obj)))
1088    (array-dimensions (lambda (array)))
1089    (array-in-bounds? (lambda (array k |...|)))
1090    (array-ref (lambda (array k |...|)))
1091    (array-set! (lambda (array obj k |...|)))
1092    )
1093
1094   ;; SRFI 48
1095   ("Intermediate Format Strings"
1096    (format (lambda (port-or-boolean format-string arg |...|))))
1097
1098   ;; SRFI 49
1099   ("Indentation-sensitive syntax"
1100    )
1101
1102   ()
1103
1104   ;; SRFI 51
1105   ("Handling rest list"
1106    (rest-values (lambda (caller rest-list :optional args-number-limit default)))
1107    (arg-and (syntax))
1108    (arg-ands (syntax))
1109    (err-and (syntax))
1110    (err-ands (syntax))
1111    (arg-or (syntax))
1112    (arg-ors (syntax))
1113    (err-or (syntax))
1114    (err-ors (syntax))
1115    )
1116
1117   ()
1118
1119   ()
1120
1121   ;; SRFI 54
1122   ("Formatting"
1123    (cat (lambda (obj |...|))))
1124
1125   ;; SRFI 55
1126   ("require-extension"
1127    (require-extension (syntax)))
1128
1129   ()
1130
1131   ;; SRFI 57
1132   ("Records"
1133    (define-record-type (syntax))
1134    (define-record-scheme (syntax))
1135    (record-update (syntax))
1136    (record-update! (syntax))
1137    (record-compose (syntax)))
1138
1139   ;; SRFI 58
1140   ("Array Notation"
1141    )
1142
1143   ;; SRFI 59
1144   ("Vicinity"
1145    (program-vicinity (lambda ()))
1146    (library-vicinity (lambda ()))
1147    (implementation-vicinity (lambda ()))
1148    (user-vicinity (lambda ()))
1149    (home-vicinity (lambda ()))
1150    (in-vicinity (lambda (vicinity filename)))
1151    (sub-vicinity (lambda (vicinity name)))
1152    (make-vicinity (lambda (dirname)))
1153    (path-vicinity (lambda (path)))
1154    (vicinity:suffix? (lambda (ch)))
1155    )
1156
1157   ;; SRFI 60
1158   ("Integers as Bits"
1159    (bitwise-and (lambda (n |...|) int))
1160    (bitwise-ior (lambda (n |...|) int))
1161    (bitwise-xor (lambda (n |...|) int))
1162    (bitwise-not (lambda (n) int))
1163    (bitwise-if (lambda (mask n m) int))
1164    (any-bits-set? (lambda (n m) bool))
1165    (bit-count (lambda (n) int))
1166    (integer-length (lambda (n) int))
1167    (first-bit-set (lambda (n) int))
1168    (bit-set? (lambda (i n) bool))
1169    (copy-bit (lambda (index n bool) int))
1170    (bit-field (lambda (n start end) int))
1171    (copy-bit-field (lambda (to-int from-int start end) int))
1172    (arithmetic-shift (lambda (n count) int))
1173    (rotate-bit-field (lambda (n count start end) int))
1174    (reverse-bit-field (lambda (n start end) int))
1175    (integer->list (lambda (k :optional len) list))
1176    (list->integer (lambda (list) int))
1177    )
1178
1179   ;; SRFI 61
1180   ("A more general cond clause"
1181    (cond (syntax)))
1182
1183   ;; SRFI 62
1184   ("S-expression comments"
1185    )
1186
1187   ;; SRFI 63
1188   ("Homogeneous and Heterogeneous Arrays"
1189    )
1190
1191   ;; SRFI 64
1192   ("A Scheme API for test suites"
1193    (test-assert (syntax))
1194    (test-eqv (syntax))
1195    (test-equal (syntax))
1196    (test-eq (syntax))
1197    (test-approximate (syntax))
1198    (test-error (syntax))
1199    (test-read-eval-string (lambda (string)))
1200    (test-begin (syntax (suite-name :optional count)))
1201    (test-end (syntax (suite-name)))
1202    (test-group (syntax (suite-name decl-or-expr |...|)))
1203    (test-group-with-cleanup (syntax (suite-name decl-or-expr |...|)))
1204    (test-match-name (lambda (name)))
1205    (test-match-nth (lambda (n :optional count)))
1206    (test-match-any (lambda (specifier |...|)))
1207    (test-match-all (lambda (specifier |...|)))
1208    (test-skip (syntax (specifier)))
1209    (test-expect-fail (syntax (specifier)))
1210    (test-runner? (lambda (obj)))
1211    (test-runner-current (lambda (:optional runner)))
1212    (test-runner-get (lambda ()))
1213    (test-runner-simple (lambda ()))
1214    (test-runner-null (lambda ()))
1215    (test-runner-create (lambda ()))
1216    (test-runner-factory (lambda (:optional factory)))
1217    (test-apply (syntax (runner specifier |...|)))
1218    (test-with-runner (syntax (runner decl-or-expr |...|)))
1219    (test-result-kind (lambda (:optional runner)))
1220    (test-passed? (lambda (:optional runner)))
1221    (test-result-ref (lambda (runner prop-name (:optional default))))
1222    (test-result-set! (lambda (runner prop-name value)))
1223    (test-result-remove (lambda (runner prop-name)))
1224    (test-result-clear (lambda (runner)))
1225    (test-result-alist (lambda (runner)))
1226    (test-runner-on-test-begin (lambda (runner :optional proc)))
1227    (test-runner-on-test-begin! (lambda (runner :optional proc)))
1228    (test-runner-on-test-end (lambda (runner :optional proc)))
1229    (test-runner-on-test-end! (lambda (runner :optional proc)))
1230    (test-runner-on-group-begin (lambda (runner :optional proc)))
1231    (test-runner-on-group-begin! (lambda (runner :optional proc)))
1232    (test-runner-on-group-end (lambda (runner :optional proc)))
1233    (test-runner-on-group-end! (lambda (runner :optional proc)))
1234    (test-runner-on-bad-count (lambda (runner :optional proc)))
1235    (test-runner-on-bad-count! (lambda (runner :optional proc)))
1236    (test-runner-on-bad-end-name (lambda (runner :optional proc)))
1237    (test-runner-on-bad-end-name! (lambda (runner :optional proc)))
1238    (test-runner-on-final (lambda (runner :optional proc)))
1239    (test-runner-on-final! (lambda (runner :optional proc)))
1240    (test-runner-pass-count (lambda (runner)))
1241    (test-runner-fail-count (lambda (runner)))
1242    (test-runner-xpass-count (lambda (runner)))
1243    (test-runner-skip-count (lambda (runner)))
1244    (test-runner-test-name (lambda (runner)))
1245    (test-runner-group-path (lambda (runner)))
1246    (test-runner-group-stack (lambda (runner)))
1247    (test-runner-aux-value (lambda (runner)))
1248    (test-runner-aux-value! (lambda (runner)))
1249    (test-runner-reset (lambda (runner)))
1250    )
1251
1252   ()
1253
1254   ;; SRFI 66
1255   ("Octet Vectors"
1256    (make-u8vector (lambda (len n)))
1257    (u8vector (lambda (n |...|)))
1258    (u8vector->list (lambda (u8vector)))
1259    (list->u8vector (lambda (octet-list)))
1260    (u8vector-length u8vector)
1261    (u8vector-ref (lambda (u8vector k)))
1262    (u8vector-set! (lambda (u8vector k n)))
1263    (u8vector=? (lambda (u8vector-1 u8vector-2)))
1264    (u8vector-compare (lambda (u8vector-1 u8vector-2)))
1265    (u8vector-copy! (lambda (source source-start target target-start n)))
1266    (u8vector-copy (lambda (u8vector)))
1267    )
1268
1269   ;; SRFI 67
1270   ("Compare Procedures"
1271    )
1272
1273   ()
1274
1275   ;; SRFI 69
1276   ("Basic hash tables"
1277    )
1278
1279   ;; SRFI 70
1280   ("Numbers"
1281    )
1282
1283   ;; SRFI 71
1284   ("LET-syntax for multiple values"
1285    )
1286
1287   ;; SRFI 72
1288   ("Simple hygienic macros"
1289    )
1290
1291   ()
1292
1293   ;; SRFI 74
1294   ("Octet-Addressed Binary Blocks"
1295    )
1296
1297   ])
1298
1299(defvar *scheme-chicken-modules*
1300  '((extras
1301     (->string (lambda (obj) str))
1302     (alist->hash-table (lambda (alist) hash-table))
1303     (alist-ref (lambda (alist key :optional eq-fn default)))
1304     (alist-update! (lambda (key value alist :optional eq-fn) undefined))
1305     (atom? (lambda (obj) bool))
1306     (binary-search (lambda (vec proc)))
1307     (butlast (lambda (list) list) "drops the last element of list")
1308     (call-with-input-string (lambda (string proc)))
1309     (call-with-output-string (lambda (proc) str))
1310     (chop (lambda (list k) list))
1311     (complement (lambda (f) f2))
1312     (compose (lambda (f1 f2 |...|) f))
1313     (compress (lambda (boolean-list list)))
1314     (conc (lambda (obj |...|)))
1315     (conjoin (lambda (pred |...|) pred))
1316     (constantly (lambda (obj |...|) f))
1317     (disjoin (lambda (pred |...|) pred))
1318     (each (lambda (proc |...|) proc))
1319     (flatten (lambda (list1 |...|) list))
1320     (flip (lambda (proc) proc))
1321     (format (lambda (format-string arg |...|)))
1322     (fprintf (lambda (port format-string arg |...|)))
1323     (hash (lambda (obj :optional n) int))
1324     (hash-by-identity (lambda (obj :optional n) int))
1325     (hash-table->alist (lambda (hash-table) alist))
1326     (hash-table-copy (lambda (hash-table) hash-table))
1327     (hash-table-delete! (lambda (hash-table key) undefined))
1328     (hash-table-equivalence-function (lambda (hash-table) pred))
1329     (hash-table-exists? (lambda (hash-table key) bool))
1330     (hash-table-fold (lambda (hash-table f init-value)))
1331     (hash-table-hash-function (lambda (hash-table) f))
1332     (hash-table-keys (lambda (hash-table) list))
1333     (hash-table-merge! (lambda (hash-table1 hash-table2) undefined))
1334     (hash-table-ref (lambda (hash-table key :optional thunk)))
1335     (hash-table-ref/default (lambda (hash-table key default)))
1336     (hash-table-remove! (lambda (hash-table proc) undefined))
1337     (hash-table-set! (lambda (hash-table key value) undefined))
1338     (hash-table-size (lambda (hash-table) n))
1339     (hash-table-update! (lambda (hash-table key proc :optional thunk) undefined))
1340     (hash-table-update!/default (lambda (hash-table key proc default) undefined))
1341     (hash-table-values (lambda (hash-table) list))
1342     (hash-table-walk (lambda (hash-table proc) undefined))
1343     (hash-table? (lambda (obj) bool))
1344     (identity (lambda (obj)))
1345     (intersperse (lambda (list obj) list))
1346     (join (lambda (list-of-lists :optional list) list))
1347     (list->queue (lambda (list) queue))
1348     (list-of (lambda (pred)))
1349     (make-hash-table (lambda (:optional eq-fn hash-fn size) hash-table))
1350     (make-input-port (lambda (read-proc ready?-pred close-proc :optional peek-proc) input-port))
1351     (make-output-port (lambda (write-proc close-proc :optional flush-proc) output-port))
1352     (make-queue (lambda () queue))
1353     (merge (lambda (list1 list2 less-fn) list))
1354     (merge! (lambda (list1 list2 less-fn) list))
1355     (noop (lambda (obj |...|) undefined))
1356     (pp (lambda (obj :optional output-port) undefined))
1357     (pretty-print (lambda (obj :optional output-port) undefined))
1358     (pretty-print-width (lambda (:optional new-width) n))
1359     (printf (lambda (format-string arg |...|) undefined))
1360     (project (lambda (n) proc))
1361     (queue->list (lambda (queue) list))
1362     (queue-add! (lambda (queue obj) undefined))
1363     (queue-empty? (lambda (queue) bool))
1364     (queue-first (lambda (queue)))
1365     (queue-last (lambda (queue)))
1366     (queue-push-back! (lambda (queue obj) undefined))
1367     (queue-push-back-list! (lambda (queue list) undefined))
1368     (queue-remove! (lambda (queue) undefined))
1369     (queue? (lambda (obj) bool))
1370     (random (lambda (n) n))
1371     (randomize (lambda (:optional x) undefined))
1372     (rassoc (lambda (key list :optional eq-fn)))
1373     (read-file (lambda (:optional file-or-port reader-fn max-count) str))
1374     (read-line (lambda (:optional port limit) str))
1375     (read-lines (lambda (:optional port max) list))
1376     (read-string (lambda (:optional n port) str))
1377     (read-string! (lambda (n dest :optional port start) undefined))
1378     (read-token (lambda (predicate :optional port) str))
1379     (shuffle (lambda (list) list))
1380     (sort (lambda (sequence less-fn) sequence))
1381     (sort! (lambda (sequence less-fn) sequence))
1382     (sorted? (lambda (sequence less-fn) bool))
1383     (sprintf (lambda (format-string arg |...|) str))
1384     (string-chomp (lambda (str :optional suffix-str) str))
1385     (string-chop (lambda (str length) list))
1386     (string-ci-hash (lambda (str :optional n) n))
1387     (string-compare3 (lambda (str1 str2) n))
1388     (string-compare3-ci (lambda (str1 str2) n))
1389     (string-hash (lambda (str1 :optional n) n))
1390     (string-intersperse (lambda (list :optional seperator-string) str))
1391     (string-split (lambda (str :optional delimiter-str keep-empty?) list))
1392     (string-translate (lambda (str from-str :optional to-str) str))
1393     (string-translate* (lambda (str list) str))
1394     (substring-ci=? (lambda (str1 str2 :optional start1 start2 length) str))
1395     (substring-index (lambda (which-str where-str :optional start) i))
1396     (substring-index-ci (lambda (which-str where-str :optional start) i))
1397     (substring=? (lambda (str1 str2 :optional start1 start2 length) bool))
1398     (tail? (lambda (obj list) bool))
1399     (with-error-output-to-port (lambda (output-port thunk)))
1400     (with-input-from-port (lambda (port thunk)))
1401     (with-input-from-string (lambda (str thunk)))
1402     (with-output-to-port (lambda (port thunk)))
1403     (with-output-to-string (lambda (thunk) str))
1404     (write-line (lambda (str :optional port) undefined))
1405     (write-string (lambda (str :optional num port) undefined))
1406     )
1407    (lolevel
1408     (address->pointer (lambda (n) ptr))
1409     (align-to-word (lambda (ptr-or-int) ptr))
1410     (allocate (lambda (size) block))
1411     (block-ref (lambda (block index) int))
1412     (block-set! (lambda (block index obj) undefined))
1413     (byte-vector (lambda (n |...|) byte-vector))
1414     (byte-vector->list (lambda (byte-vector) list))
1415     (byte-vector->string (lambda (byte-vector) string))
1416     (byte-vector-fill! (lambda (byte-vector n) undefined))
1417     (byte-vector-length (lambda (byte-vector) n))
1418     (byte-vector-ref (lambda (byte-vector i) int))
1419     (byte-vector-set! (lambda (byte-vector i n) undefined))
1420     (byte-vector? (lambda (obj) bool))
1421     (extend-procedure (lambda (proc x) proc))
1422     (extended-procedure? (lambda (proc) bool))
1423     (free (lambda (pointer) undefined))
1424     (global-bound? (lambda (sym) bool))
1425     (global-make-unbound! (lambda (sym) undefined))
1426     (global-ref (lambda (sym)))
1427     (global-set! (lambda (sym val) undefined))
1428     (list->byte-vector (lambda (list) byte-vector))
1429     (locative->object (lambda (locative) obj))
1430     (locative-ref (lambda (locative)))
1431     (locative-set! (lambda (locative val) undefined))
1432     (locative? (lambda (obj) bool))
1433     (make-byte-vector (lambda (size :optional init-n) byte-vector))
1434     (make-locative (lambda (obj :optional index) locative))
1435     (make-record-instance (lambda (sym arg |...|)))
1436     (make-static-byte-vector (lambda (size :optional init-n)))
1437     (make-weak-locative (lambda (obj :optional index) locative))
1438     (move-memory! (lambda (from to :optional bytes from-offset to-offset) undefined))
1439     (mutate-procedure (lambda (proc proc) proc))
1440     (null-pointer (lambda () pointer))
1441     (null-pointer? (lambda (pointer) bool))
1442     (number-of-bytes (lambda (block) int))
1443     (number-of-slots (lambda (block) int))
1444     (object->pointer (lambda (obj) ptr))
1445     (object-become! (lambda (alist) undefined))
1446     (object-copy (lambda (obj)))
1447     (object-evict (lambda (obj :optional allocator-proc)))
1448     (object-evict-to-location (lambda (obj ptr :optional limit)))
1449     (object-evicted? (lambda (obj) bool))
1450     (object-release (lambda (obj :optional releaser-proc)))
1451     (object-size (lambda (obj) int))
1452     (object-unevict (lambda (obj :optional full)))
1453     (pointer->address (lambda (ptr) n))
1454     (pointer->object (lambda (ptr)))
1455     (pointer-f32-ref (lambda (ptr) real))
1456     (pointer-f32-set! (lambda (ptr x) undefined))
1457     (pointer-f64-ref (lambda (ptr) real))
1458     (pointer-f64-set! (lambda (ptr x) undefined))
1459     (pointer-offset (lambda (ptr n) n))
1460     (pointer-s16-ref (lambda (ptr) int))
1461     (pointer-s16-set! (lambda (ptr n) undefined))
1462     (pointer-s32-ref (lambda (ptr) int))
1463     (pointer-s32-set! (lambda (ptr n) undefined))
1464     (pointer-s8-ref (lambda (ptr) int))
1465     (pointer-s8-set! (lambda (ptr n) undefined))
1466     (pointer-tag (lambda (ptr) tag))
1467     (pointer-u16-ref (lambda (ptr) int))
1468     (pointer-u16-set! (lambda (ptr n) undefined))
1469     (pointer-u32-ref (lambda (ptr) int))
1470     (pointer-u32-set! (lambda (ptr n) undefined))
1471     (pointer-u8-ref (lambda (ptr) int))
1472     (pointer-u8-set! (lambda (ptr n) undefined))
1473     (pointer=? (lambda (ptr1 ptr2) bool))
1474     (pointer? (lambda (obj) bool))
1475     (procedure-data (lambda (proc)))
1476     (record->vector (lambda (block) vector))
1477     (record-instance? (lambda (obj) bool))
1478     (set-invalid-procedure-call-handler! (lambda (proc) undefined))
1479     (set-procedure-data! (lambda (proc obj) undefined))
1480     (static-byte-vector->pointer (lambda (byte-vector) pointer))
1481     (string->byte-vector (lambda (str) byte-vector))
1482     (tag-pointer (lambda (ptr tag)))
1483     (tagged-pointer? (lambda (obj tag) bool))
1484     (unbound-variable-value (lambda (:optional value)))
1485     )
1486    (posix
1487     (_exit (lambda (:optional n) undefined))
1488     (call-with-input-pipe (lambda (cmdline-string proc :optional mode)))
1489     (call-with-output-pipe (lambda (cmdline-string proc :optional mode)))
1490     (change-directory (lambda (dir)))
1491     (change-file-mode (lambda (filename mode)))
1492     (change-file-owner (lambda (filename user-n group-n)))
1493     (close-input-pipe (lambda (input-port)))
1494     (close-output-pipe (lambda (output-port)))
1495     (create-directory (lambda (filename)))
1496     (create-fifo (lambda (filename :optional mode)))
1497     (create-pipe (lambda ()))
1498     (create-session (lambda ()))
1499     (create-symbolic-link (lambda (old-filename new-filename)))
1500     (current-directory (lambda (:optional new-dir)))
1501     (current-effective-group-id (lambda () int))
1502     (current-effective-user-id (lambda () int))
1503     (current-environment (lambda ()))
1504     (current-group-id (lambda ()))
1505     (current-process-id (lambda ()))
1506     (current-user-id (lambda ()))
1507     (delete-directory (lambda (dir)))
1508     (directory (lambda (:optional dir show-dotfiles?) list))
1509     (directory? (lambda (filename) bool))
1510     (duplicate-fileno (lambda (old-n :optional new-n)))
1511;;      (errno/acces integer)
1512;;      (errno/again integer)
1513;;      (errno/badf integer)
1514;;      (errno/busy integer)
1515;;      (errno/child integer)
1516;;      (errno/exist integer)
1517;;      (errno/fault integer)
1518;;      (errno/intr integer)
1519;;      (errno/inval integer)
1520;;      (errno/io integer)
1521;;      (errno/isdir integer)
1522;;      (errno/mfile integer)
1523;;      (errno/noent integer)
1524;;      (errno/noexec integer)
1525;;      (errno/nomem integer)
1526;;      (errno/nospc integer)
1527;;      (errno/notdir integer)
1528;;      (errno/perm integer)
1529;;      (errno/pipe integer)
1530;;      (errno/rofs integer)
1531;;      (errno/spipe integer)
1532;;      (errno/srch integer)
1533;;      (errno/wouldblock integer)
1534     (fifo? (lambda (filename) bool))
1535     (file-access-time (lambda (filename) real))
1536     (file-change-time (lambda (filename) real))
1537     (file-close (lambda (fileno)))
1538     (file-execute-access? (lambda (filename) bool))
1539     (file-link (lambda (old-filename new-filename)))
1540     (file-lock (lambda (port :optional start len)))
1541     (file-lock/blocking (lambda (port :optional start len)))
1542     (file-mkstemp (lambda (template-filename)))
1543     (file-modification-time (lambda (filename) real))
1544     (file-open (lambda (filename (flags open-mode open/binary open/excl open/fsync open/noctty open/nonblock open/rdonly open/rdwr open/read open/sync open/text) :optional mode) fileno))
1545     (file-owner (lambda (filename)))
1546     (file-permissions (lambda (filename) int))
1547     (file-position (lambda (port-or-fileno) int))
1548     (file-read (lambda (fileno size :optional buffer-string)))
1549     (file-read-access? (lambda (filename) bool))
1550     (file-select (lambda (read-fd-list write-fd-list :optional timeout)))
1551     (file-size (lambda (filename) int))
1552     (file-stat (lambda (filename :optional follow-link?)))
1553     (file-test-lock (lambda (port :optional start len)))
1554     (file-truncate (lambda (filename-or-fileno offset)))
1555     (file-unlock (lambda (lock)))
1556     (file-write (lambda (fileno buffer-string :optional size)))
1557     (file-write-access? (lambda (filename)))
1558     (fileno/stderr integer)
1559     (fileno/stdin integer)
1560     (fileno/stdout integer)
1561     (find-files (lambda (dir pred :optional action-proc identity limit)))
1562     (get-groups (lambda ()))
1563     (get-host-name (lambda ()))
1564     (glob (lambda (pattern1 |...|)))
1565     (group-information (lambda (group-name-or-n)))
1566     (initialize-groups (lambda (user-name base-group-n)))
1567     (local-time->seconds (lambda (vector)))
1568     (local-timezone-abbreviation (lambda ()))
1569     (map-file-to-memory (lambda (address len protection flag fileno :optional offset)))
1570     (memory-mapped-file-pointer (lambda (mmap)))
1571     (memory-mapped-file? (lambda (obj)))
1572     (open-input-file* (lambda (fileno :optional (flags open-mode open/binary open/excl open/fsync open/noctty open/nonblock open/rdonly open/rdwr open/read open/sync open/text))))
1573     (open-input-pipe (lambda (cmdline-string :optional mode)))
1574     (open-output-file* (lambda (fileno :optional (flags open-mode open/append open/binary open/creat open/excl open/fsync open/noctty open/nonblock open/rdwr open/sync open/text open/trunc open/write open/wronly))))
1575     (open-output-pipe (lambda (cmdline-string :optional mode)))
1576;;      (open/append integer)
1577;;      (open/binary integer)
1578;;      (open/creat integer)
1579;;      (open/excl integer)
1580;;      (open/fsync integer)
1581;;      (open/noctty integer)
1582;;      (open/nonblock integer)
1583;;      (open/rdonly integer)
1584;;      (open/rdwr integer)
1585;;      (open/read integer)
1586;;      (open/sync integer)
1587;;      (open/text integer)
1588;;      (open/trunc integer)
1589;;      (open/write integer)
1590;;      (open/wronly integer)
1591     (parent-process-id (lambda ()))
1592;;      (perm/irgrp integer)
1593;;      (perm/iroth integer)
1594;;      (perm/irusr integer)
1595;;      (perm/irwxg integer)
1596;;      (perm/irwxo integer)
1597;;      (perm/irwxu integer)
1598;;      (perm/isgid integer)
1599;;      (perm/isuid integer)
1600;;      (perm/isvtx integer)
1601;;      (perm/iwgrp integer)
1602;;      (perm/iwoth integer)
1603;;      (perm/iwusr integer)
1604;;      (perm/ixgrp integer)
1605;;      (perm/ixoth integer)
1606;;      (perm/ixusr integer)
1607;;      (pipe/buf integer)
1608     (port->fileno (lambda (port)))
1609     (process (lambda (cmdline-string :optional arg-list env-list)))
1610     (process-execute (lambda (filename :optional arg-list env-list)))
1611     (process-fork (lambda (:optional thunk)))
1612     (process-group-id (lambda ()))
1613     (process-run (lambda (filename :optional list)))
1614     (process-signal (lambda (pid :optional signal)))
1615     (process-wait (lambda (:optional pid nohang?)))
1616     (read-symbolic-link (lambda (filename)))
1617     (regular-file? (lambda (filename)))
1618     (seconds->local-time (lambda (seconds)))
1619     (seconds->string (lambda (seconds)))
1620     (seconds->utc-time (lambda (seconds)))
1621     (set-alarm! (lambda (seconds)))
1622     (set-buffering-mode! (lambda (port mode :optional buf-size)))
1623     (set-file-position! (lambda (port-or-fileno pos :optional whence)))
1624     (set-group-id! (lambda (n)))
1625     (set-groups! (lambda (group-n-list)))
1626     (set-process-group-id! (lambda (process-n n)))
1627     (set-root-directory! (lambda (dir)) "chroot")
1628     (set-signal-handler! (lambda (sig-n proc)))
1629     (set-signal-mask! (lambda (sig-n-list)))
1630     (set-user-id! (lambda (n)))
1631     (setenv (lambda (name value-string)))
1632;;      (signal/abrt integer)
1633;;      (signal/alrm integer)
1634;;      (signal/chld integer)
1635;;      (signal/cont integer)
1636;;      (signal/fpe integer)
1637;;      (signal/hup integer)
1638;;      (signal/ill integer)
1639;;      (signal/int integer)
1640;;      (signal/io integer)
1641;;      (signal/kill integer)
1642;;      (signal/pipe integer)
1643;;      (signal/prof integer)
1644;;      (signal/quit integer)
1645;;      (signal/segv integer)
1646;;      (signal/stop integer)
1647;;      (signal/term integer)
1648;;      (signal/trap integer)
1649;;      (signal/tstp integer)
1650;;      (signal/urg integer)
1651;;      (signal/usr1 integer)
1652;;      (signal/usr2 integer)
1653;;      (signal/vtalrm integer)
1654;;      (signal/winch integer)
1655;;      (signal/xcpu integer)
1656;;      (signal/xfsz integer)
1657     (sleep (lambda (seconds)))
1658     (symbolic-link? (lambda (filename)))
1659     (system-information (lambda ()))
1660     (terminal-name (lambda (port)))
1661     (terminal-port? (lambda (port)))
1662     (time->string (lambda (vector)))
1663     (unmap-file-from-memory (lambda (mmap :optional len)))
1664     (unsetenv (lambda (name) undefined))
1665     (user-information (lambda ((or integer (string complete-user-name))) list))
1666     (utc-time->seconds (lambda (vector)))
1667     (with-input-from-pipe (lambda (cmdline-string thunk :optional mode)))
1668     (with-output-to-pipe (lambda (cmdline-string thunk :optional mode)))
1669     )
1670    (regex
1671     (glob->regexp (lambda (pattern)))
1672     (glob? (lambda (obj)))
1673     (grep (lambda (pattern list) list))
1674     (regexp (lambda (pattern ignore-case? ignore-space? utf-8?)))
1675     (regexp-escape (lambda (str) str))
1676     (regexp? (lambda (obj) bool))
1677     (string-match (lambda (pattern str :optional start)))
1678     (string-match-positions (lambda (pattern str :optional start)))
1679     (string-search (lambda (pattern str :optional start)))
1680     (string-search-positions (lambda (pattern str :optional start)))
1681     (string-split-fields (lambda (pattern str :optional mode start)))
1682     (string-substitute (lambda (pattern subst str :optional mode)))
1683     (string-substitute* (lambda (str subst-list :optional mode)))
1684     )
1685    (tcp
1686     (tcp-abandon-port (lambda (port)))
1687     (tcp-accept (lambda (listener)))
1688     (tcp-accept-ready? (lambda (listener)))
1689     (tcp-addresses (lambda (port)))
1690     (tcp-buffer-size (lambda (:optional new-size)))
1691     (tcp-close (lambda (listener)))
1692     (tcp-connect (lambda ((string complete-host-name) :optional (string complete-port-name))))
1693     (tcp-listen (lambda (tcp-port-n :optional backlog-n host-string)))
1694     (tcp-listener-fileno (lambda (listener)))
1695     (tcp-listener-port (lambda (listener)))
1696     (tcp-listener? (lambda (obj)))
1697     (tcp-port-numbers (lambda (port)))
1698     )
1699    (utils
1700     (absolute-pathname? (lambda (pathname)))
1701     (create-temporary-file (lambda (:optional ext-str)))
1702     (decompose-pathname (lambda (pathname)))
1703     (delete-file* (lambda (filename)))
1704     (for-each-argv-line (lambda (proc) undefined))
1705     (for-each-line (lambda (proc :optional input-port) undefined))
1706     (make-absolute-pathname (lambda (dir filename :optional ext-str)))
1707     (make-pathname (lambda (dir filename :optional ext-str)))
1708     (pathname-directory (lambda (pathname)))
1709     (pathname-extension (lambda (pathname)))
1710     (pathname-file (lambda (pathname)))
1711     (pathname-replace-directory (lambda (pathname dir)))
1712     (pathname-replace-extension (lambda (pathname ext-str)))
1713     (pathname-replace-file (lambda (pathname filename)))
1714     (pathname-strip-directory (lambda (pathname)))
1715     (pathname-strip-extension (lambda (pathname)))
1716     (port-for-each (lambda (read-fn thunk) undefined))
1717     (port-map (lambda (read-fn thunk)))
1718     (read-all (lambda (:optional file-or-port)))
1719     (shift! (lambda (list :optional default)))
1720     (system* (lambda (format-string arg1 |...|)))
1721     (unshift! (lambda (obj pair)))
1722     )
1723    ))
1724
1725;; another big table - consider moving to a separate file
1726(defvar *scheme-implementation-exports*
1727  '((chicken
1728     (abort (lambda (obj) undefined))
1729     (add1 (lambda (z) z))
1730     (andmap (lambda (pred list) bool))
1731     (any? (lambda (obj) bool))
1732     (argc+argv (lambda () (values n ptr)))
1733     (argv (lambda () list))
1734     (bit-set? (lambda (n index) bool))
1735     (bitwise-and (lambda (n |...|) n))
1736     (bitwise-ior (lambda (n |...|) n))
1737     (bitwise-not (lambda (n |...|) n))
1738     (bitwise-xor (lambda (n |...|) n))
1739     (blob->string (lambda (blob) string))
1740     (blob-size (lambda (blob) n))
1741     (blob? (lambda (obj) bool))
1742     (breakpoint (lambda (:optional name)))
1743     (build-platform (lambda () symbol))
1744     (c-runtime (lambda () symbol))
1745     (call/cc (lambda (proc)))
1746     (case-sensitive (lambda (:optional on?)))
1747     (chicken-home (lambda () string))
1748     (chicken-version (lambda () string))
1749     (command-line-arguments (lambda () list))
1750     (condition-predicate (lambda (kind) pred))
1751     (condition-property-accessor (lambda (kind prop :optional err?) proc))
1752     (condition? (lambda (obj) bool))
1753     (continuation-capture (lambda (proc)))
1754     (continuation-graft (lambda (continuation thunk)))
1755     (continuation-return (lambda (continuation vals|...|)))
1756     (continuation? (lambda (obj) bool))
1757     (copy-read-table (lambda (read-table) read-table))
1758     (cpu-time (lambda () (values n n)))
1759     (current-error-port (lambda () output-port))
1760     (current-exception-handler (lambda () proc))
1761     (current-gc-milliseconds (lambda () n))
1762     (current-milliseconds (lambda () n))
1763     (current-read-table (lambda () read-table))
1764     (current-seconds (lambda () x))
1765     (define-reader-ctor (lambda (sym proc) undefined))
1766     (delete-file (lambda (filename) undefined))
1767     (disable-interrupts (lambda () undefined))
1768     (dynamic-load-libraries (lambda () list))
1769     (dynamic-wind (lambda (before-thunk thunk after-thunk)))
1770     (enable-interrupts (lambda () undefined))
1771     (enable-warnings (lambda () undefined))
1772     (errno (lambda () n))
1773     (error (lambda (error-string args |...|) undefined))
1774     (eval-handler (lambda () proc))
1775     (exit (lambda (:optional n) undefined))
1776     (exit-handler (lambda () proc))
1777     (extension-info (lambda (proc)))
1778     (extension-information (lambda (proc)))
1779     (feature? (lambda (sym) bool))
1780     (features (lambda () list))
1781     (file-exists? (lambda (filename) bool))
1782     (finite? (lambda (z) bool))
1783     (fixnum? (lambda (obj) bool))
1784     (flonum? (lambda (obj) bool))
1785     (flush-output (lambda (:optional port) undefined))
1786     (force (lambda (promise)))
1787     (force-finalizers (lambda (f args |...|)))
1788     (fp* (lambda (x1 x2) x))
1789     (fp+ (lambda (x1 x2) x))
1790     (fp- (lambda (x1 x2) x))
1791     (fp/ (lambda (x1 x2) x))
1792     (fp< (lambda (x1 x2) x))
1793     (fp<= (lambda (x1 x2) x))
1794     (fp= (lambda (x1 x2) x))
1795     (fp> (lambda (x1 x2) x))
1796     (fp>= (lambda (x1 x2) x))
1797     (fpmax (lambda (x1 x2) x))
1798     (fpmin (lambda (x1 x2) x))
1799     (fpneg (lambda (x1 x2) x))
1800     (fx* (lambda (n1 n2) n))
1801     (fx+ (lambda (n1 n2) n))
1802     (fx- (lambda (n1 n2) n))
1803     (fx/ (lambda (n1 n2) n))
1804     (fx< (lambda (n1 n2) n))
1805     (fx<= (lambda (n1 n2) n))
1806     (fx= (lambda (n1 n2) n))
1807     (fx> (lambda (n1 n2) n))
1808     (fx>= (lambda (n1 n2) n))
1809     (fxand (lambda (n1 n2) n))
1810     (fxior (lambda (n1 n2) n))
1811     (fxmax (lambda (n1 n2) n))
1812     (fxmin (lambda (n1 n2) n))
1813     (fxmod (lambda (n1 n2) n))
1814     (fxneg (lambda (n1 n2) n))
1815     (fxnot (lambda (n1 n2) n))
1816     (fxshl (lambda (n1 n2) n))
1817     (fxshr (lambda (n1 n2) n))
1818     (fxxor (lambda (n1 n2) n))
1819     (gc (lambda () n))
1820     (gensym (lambda (:optional name) sym))
1821     (get-call-chain (lambda (:optional n) list))
1822     (get-keyword (lambda (sym list :optional default)))
1823     (get-line-number (lambda (sexp) n))
1824     (get-output-string (lambda (string-output-port) string))
1825     (getenv (lambda (name) string))
1826     (getter-with-setter (lambda (get-proc set-proc) proc))
1827     (implicit-exit-handler (lambda (:optional proc) proc))
1828     (invalid-procedure-call-handler (lambda (:optional proc) proc))
1829     (keyword->string (lambda (sym) string))
1830     (keyword-style (lambda (:optional sym) sym))
1831     (keyword? (lambda (obj) bool))
1832     (load-library (lambda (sym) undefined))
1833     (load-noisily (lambda (string) undefined))
1834     (load-relative (lambda (string) undefined))
1835     (load-verbose (lambda (:optional bool) bool))
1836     (machine-byte-order (lambda () sym))
1837     (machine-type (lambda () sym))
1838     (macro? (lambda (obj) bool))
1839     (macroexpand (lambda (sexp) sexp))
1840     (macroexpand-1 (lambda (sexp) sexp))
1841     (make-blob (lambda (size) blob))
1842     (make-composite-condition (lambda (condition |...|) condition))
1843     (make-parameter (lambda (val) proc))
1844     (make-property-condition (lambda (kind |...|) condition))
1845     (match-error-control (lambda (:optional proc) proc))
1846     (match-error-procedure (lambda (:optional proc) proc))
1847     (memory-statistics (lambda () vector))
1848     (on-exit (lambda (thunk) undefined))
1849     (open-input-string (lambda (string) string-input-port))
1850     (open-output-string (lambda () string-output-port))
1851     (ormap (lambda (pred list |...|) bool))
1852     (port-name (lambda (port) name))
1853     (port-position (lambda (port) n))
1854     (port? (lambda (obj) bool))
1855     (print (lambda (obj |...|) undefined))
1856     (print* (lambda (obj |...|) undefined))
1857     (print-backtrace (lambda (:optional n) undefined))
1858     (print-call-chain (lambda (:optional n) undefined))
1859     (print-error-message (lambda (err args |...|) undefined))
1860     (procedure-information (lambda (proc)))
1861     (program-name (lambda (:optional name) name))
1862     (provide (lambda (name)))
1863     (provided? (lambda (name) bool))
1864     (rational? (lambda (obj) bool))
1865     (read-byte (lambda (:optional input-port) n))
1866     (register-feature! (lambda (name) undefined))
1867     (rename-file (lambda (old-name new-name) undefined))
1868     (repl (lambda () undefined))
1869     (repository-path (lambda (:optional dirname) dirname))
1870     (require (lambda (sym |...|) undefined))
1871     (reset (lambda () undefined))
1872     (reset-handler (lambda (:optional proc) proc))
1873     (return-to-host (lambda () undefined))
1874     (reverse-list->string (lambda (list) string))
1875     (set-dynamic-load-mode! (lambda (obj) undefined))
1876     (set-extension-specifier! (lambda (name proc) undefined))
1877     (set-finalizer! (lambda (obj proc) undefined))
1878     (set-gc-report! (lambda (bool) undefined))
1879     (set-parameterized-read-syntax! (lambda (ch proc) undefined))
1880     (set-port-name! (lambda (port name) undefined))
1881     (set-read-syntax! (lambda (ch proc) undefined))
1882     (set-sharp-read-syntax! (lambda (ch proc) undefined))
1883     (setter (lambda (proc) proc))
1884     (signal (lambda (n) undefined))
1885     (signum (lambda (x) x))
1886     (singlestep (lambda (thunk)))
1887     (software-type (lambda () sym))
1888     (software-version (lambda () sym))
1889     (string->blob (lambda (string) blob))
1890     (string->keyword (lambda (string) sym))
1891     (string->uninterned-symbol (lambda (string) sym))
1892     (string-copy (lambda (string) string))
1893     (sub1 (lambda (x) x))
1894     (syntax-error (lambda (args |...|) undefined))
1895     (system (lambda (str) n))
1896     (test-feature? (lambda (obj) bool))
1897     (undefine-macro! (lambda (sym) undefined))
1898     (unregister-feature! (lambda (sym) undefined))
1899     (use (special symbol chicken-available-modules)
1900          "import extensions into top-level namespace")
1901     (vector-copy! (lambda (from-vector to-vector :optional start) undefined))
1902     (vector-resize (lambda (vec n :optional init)))
1903     (void (lambda () undefined))
1904     (warning (lambda (msg-str args |...|) undefined))
1905     (with-exception-handler (lambda (handler thunk)))
1906     (write-byte (lambda (n :optional output-port) undefined))
1907     )
1908    (gauche
1909     (E2BIG integer)
1910     (EACCES integer)
1911     (EADDRINUSE integer)
1912     (EADDRNOTAVAIL integer)
1913     (EADV integer)
1914     (EAFNOSUPPORT integer)
1915     (EAGAIN integer)
1916     (EALREADY integer)
1917     (EBADE integer)
1918     (EBADF integer)
1919     (EBADFD integer)
1920     (EBADMSG integer)
1921     (EBADR integer)
1922     (EBADRQC integer)
1923     (EBADSLT integer)
1924     (EBFONT integer)
1925     (EBUSY integer)
1926     (ECANCELED integer)
1927     (ECHILD integer)
1928     (ECHRNG integer)
1929     (ECOMM integer)
1930     (ECONNABORTED integer)
1931     (ECONNREFUSED integer)
1932     (ECONNRESET integer)
1933     (EDEADLK integer)
1934     (EDEADLOCK integer)
1935     (EDESTADDRREQ integer)
1936     (EDOM integer)
1937     (EDOTDOT integer)
1938     (EDQUOT integer)
1939     (EEXIST integer)
1940     (EFAULT integer)
1941     (EFBIG integer)
1942     (EHOSTDOWN integer)
1943     (EHOSTUNREACH integer)
1944     (EIDRM integer)
1945     (EILSEQ integer)
1946     (EINPROGRESS integer)
1947     (EINTR integer)
1948     (EINVAL integer)
1949     (EIO integer)
1950     (EISCONN integer)
1951     (EISDIR integer)
1952     (EISNAM integer)
1953     (EKEYEXPIRED integer)
1954     (EKEYREJECTED integer)
1955     (EKEYREVOKED integer)
1956     (EL2HLT integer)
1957     (EL2NSYNC integer)
1958     (EL3HLT integer)
1959     (EL3RST integer)
1960     (ELIBACC integer)
1961     (ELIBBAD integer)
1962     (ELIBEXEC integer)
1963     (ELIBMAX integer)
1964     (ELIBSCN integer)
1965     (ELNRNG integer)
1966     (ELOOP integer)
1967     (EMEDIUMTYPE integer)
1968     (EMFILE integer)
1969     (EMLINK integer)
1970     (EMSGSIZE integer)
1971     (EMULTIHOP integer)
1972     (ENAMETOOLONG integer)
1973     (ENAVAIL integer)
1974     (ENETDOWN integer)
1975     (ENETRESET integer)
1976     (ENETUNREACH integer)
1977     (ENFILE integer)
1978     (ENOANO integer)
1979     (ENOBUFS integer)
1980     (ENOCSI integer)
1981     (ENODATA integer)
1982     (ENODEV integer)
1983     (ENOENT integer)
1984     (ENOEXEC integer)
1985     (ENOKEY integer)
1986     (ENOLCK integer)
1987     (ENOLINK integer)
1988     (ENOMEDIUM integer)
1989     (ENOMEM integer)
1990     (ENOMSG integer)
1991     (ENONET integer)
1992     (ENOPKG integer)
1993     (ENOPROTOOPT integer)
1994     (ENOSPC integer)
1995     (ENOSR integer)
1996     (ENOSTR integer)
1997     (ENOSYS integer)
1998     (ENOTBLK integer)
1999     (ENOTCONN integer)
2000     (ENOTDIR integer)
2001     (ENOTEMPTY integer)
2002     (ENOTNAM integer)
2003     (ENOTSOCK integer)
2004     (ENOTTY integer)
2005     (ENOTUNIQ integer)
2006     (ENXIO integer)
2007     (EOPNOTSUPP integer)
2008     (EOVERFLOW integer)
2009     (EPERM integer)
2010     (EPFNOSUPPORT integer)
2011     (EPIPE integer)
2012     (EPROTO integer)
2013     (EPROTONOSUPPORT integer)
2014     (EPROTOTYPE integer)
2015     (ERANGE integer)
2016     (EREMCHG integer)
2017     (EREMOTE integer)
2018     (EREMOTEIO integer)
2019     (ERESTART integer)
2020     (EROFS integer)
2021     (ESHUTDOWN integer)
2022     (ESOCKTNOSUPPORT integer)
2023     (ESPIPE integer)
2024     (ESRCH integer)
2025     (ESRMNT integer)
2026     (ESTALE integer)
2027     (ESTRPIPE integer)
2028     (ETIME integer)
2029     (ETIMEDOUT integer)
2030     (ETOOMANYREFS integer)
2031     (ETXTBSY integer)
2032     (EUCLEAN integer)
2033     (EUNATCH integer)
2034     (EUSERS integer)
2035     (EWOULDBLOCK integer)
2036     (EXDEV integer)
2037     (EXFULL integer)
2038     (F_OK integer)
2039     (LC_ALL integer)
2040     (LC_COLLATE integer)
2041     (LC_CTYPE integer)
2042     (LC_MONETARY integer)
2043     (LC_NUMERIC integer)
2044     (LC_TIME integer)
2045     (RAND_MAX integer)
2046     (R_OK integer)
2047     (SEEK_CUR integer)
2048     (SEEK_END integer)
2049     (SEEK_SET integer)
2050     (SIGABRT integer)
2051     (SIGALRM integer)
2052     (SIGBUS integer)
2053     (SIGCHLD integer)
2054     (SIGCONT integer)
2055     (SIGFPE integer)
2056     (SIGHUP integer)
2057     (SIGILL integer)
2058     (SIGINT integer)
2059     (SIGIO integer)
2060     (SIGIOT integer)
2061     (SIGKILL integer)
2062     (SIGPIPE integer)
2063     (SIGPOLL integer)
2064     (SIGPROF integer)
2065     (SIGPWR integer)
2066     (SIGQUIT integer)
2067     (SIGSEGV integer)
2068     (SIGSTKFLT integer)
2069     (SIGSTOP integer)
2070     (SIGTERM integer)
2071     (SIGTRAP integer)
2072     (SIGTSTP integer)
2073     (SIGTTIN integer)
2074     (SIGTTOU integer)
2075     (SIGURG integer)
2076     (SIGUSR1 integer)
2077     (SIGUSR2 integer)
2078     (SIGVTALRM integer)
2079     (SIGWINCH integer)
2080     (SIGXCPU integer)
2081     (SIGXFSZ integer)
2082     (SIG_BLOCK integer)
2083     (SIG_SETMASK integer)
2084     (SIG_UNBLOCK integer)
2085     (W_OK integer)
2086     (X_OK integer)
2087     (acons (lambda (key value alist) alist))
2088     (acosh (lambda (z) z))
2089     (add-load-path (lambda (path) undefined))
2090     (add-method! (lambda (generic method) undefined))
2091     (all-modules (lambda () list))
2092     (allocate-instance (lambda (class list)))
2093     (and-let* (syntax))
2094     (any (lambda (pred list)))
2095     (any$ (lambda (pred) proc))
2096     (any-pred (lambda (pred |...|) pred))
2097     (append! (lambda (list |...|) list))
2098     (apply$ (lambda (proc) proc))
2099     (apply-generic (lambda (generic list)))
2100     (apply-method (lambda (method list)))
2101     (apply-methods (lambda (generic list list)))
2102     (arity (lambda (proc) n))
2103     (arity-at-least-value (lambda (n)))
2104     (arity-at-least? (lambda (proc) bool))
2105     (ash (lambda (n i) n))
2106     (asinh (lambda (z) z))
2107     (assoc$ (lambda (obj) proc))
2108     (atanh (lambda (z) z))
2109     (autoload (syntax))
2110     (begin0 (syntax))
2111     (bignum? (lambda (obj) bool))
2112     (bit-field (lambda (n start end) n))
2113     (byte-ready? (lambda (:optional input-port) bool))
2114     (call-with-input-string (lambda (str proc)))
2115     (call-with-output-string (lambda (proc) str))
2116     (call-with-string-io (lambda (str proc) str))
2117     (case-lambda (syntax))
2118     (change-class (lambda (obj new-class)))
2119     (change-object-class (lambda (obj orig-class new-class)))
2120     (char->ucs (lambda (ch) int))
2121     (char-set (lambda (ch |...|) char-set))
2122     (char-set-contains? (lambda (char-set ch) bool))
2123     (char-set-copy (lambda (char-set) char-set))
2124     (char-set? (lambda (obj) bool))
2125     (check-arg (syntax))
2126     (circular-list? (lambda (obj) bool))
2127     (clamp (lambda (x :optional min-x max-x) x))
2128     (class-direct-methods (lambda (class) list))
2129     (class-direct-slots (lambda (class) list))
2130     (class-direct-subclasses (lambda (class) list))
2131     (class-direct-supers (lambda (class) list))
2132     (class-name (lambda (class) sym))
2133     (class-of (lambda (obj) class))
2134     (class-precedence-list (lambda (class) list))
2135     (class-slot-accessor (lambda (class id) proc))
2136     (class-slot-bound? (lambda (class id) bool))
2137     (class-slot-definition (lambda (class id)))
2138     (class-slot-ref (lambda (class slot)))
2139     (class-slot-set! (lambda (class slot val) undefined))
2140     (class-slots (lambda (class) list))
2141     (closure-code (lambda (proc)))
2142     (closure? (lambda (obj) bool))
2143     (compare (lambda (obj1 obj2) n))
2144     (complement (lambda (proc) proc))
2145     (compose (lambda (proc |...|) proc))
2146     (compute-applicable-methods (lambda (generic list)))
2147     (compute-cpl (lambda (generic list)))
2148     (compute-get-n-set (lambda (class slot)))
2149     (compute-slot-accessor (lambda (class slot)))
2150     (compute-slots (lambda (class)))
2151     (cond-expand (syntax))
2152     (condition (syntax))
2153     (condition-has-type? (lambda (condition obj)))
2154     (condition-ref (lambda (condition id)))
2155     (condition-type? (lambda (obj) bool))
2156     (condition? (lambda (obj) bool))
2157     (copy-bit (lambda (index n i) n))
2158     (copy-bit-field (lambda (n start end from) n))
2159     (copy-port (lambda (from-port to-port :optional unit-sym) undefined))
2160     (cosh (lambda (z) z))
2161     (count$ (lambda (pred) proc))
2162     (current-class-of (lambda (obj) class))
2163     (current-error-port (lambda () output-port))
2164     (current-exception-handler (lambda () handler))
2165     (current-load-history (lambda () list))
2166     (current-load-next (lambda () list))
2167     (current-load-port (lambda () port))
2168     (current-module (lambda () env))
2169     (current-thread (lambda () thread))
2170     (current-time (lambda () time))
2171     (cut (syntax))
2172     (cute (lambda (args |...|) proc))
2173     (debug-print (lambda (obj)))
2174     (debug-print-width (lambda () int))
2175     (debug-source-info (lambda (obj)))
2176     (dec! (syntax))
2177     (decode-float (lambda (x) vector))
2178     (define-class (syntax))
2179     (define-condition-type (syntax))
2180     (define-constant (syntax))
2181     (define-generic (syntax))
2182     (define-in-module (syntax))
2183     (define-inline (syntax))
2184     (define-macro (syntax))
2185     (define-method (syntax))
2186     (define-module (syntax))
2187     (define-reader-ctor (lambda (sym proc) undefined))
2188     (define-values (syntax))
2189     (delete$ (lambda (obj) proc))
2190     (delete-keyword (lambda (id list) list))
2191     (delete-keyword! (lambda (id list) list))
2192     (delete-method! (lambda (generic method) undefined))
2193     (digit->integer (lambda (ch) n))
2194     (disasm (lambda (proc) undefined))
2195     (dolist (syntax))
2196     (dotimes (syntax))
2197     (dotted-list? (lambda (obj) bool))
2198     (dynamic-load (lambda (file)))
2199     (eager (lambda (obj)))
2200     (eq-hash (lambda (obj)))
2201     (eqv-hash (lambda (obj)))
2202     (error (lambda (msg-string args |...|)))
2203     (errorf (lambda (fmt-string args |...|)))
2204     (eval-when (syntax))
2205     (every$ (lambda (pred) pred))
2206     (every-pred (lambda (pred |...|) pred))
2207     (exit (lambda (:optional n) undefined))
2208     (export (syntax))
2209     (export-all (syntax))
2210     (export-if-defined (syntax))
2211     (extend (syntax))
2212     (extract-condition (lambda (condition type)))
2213     (file-exists? (lambda (filename) bool))
2214     (file-is-directory? (lambda (filename) bool))
2215     (file-is-regular? (lambda (filename) bool))
2216     (filter$ (lambda (pred) proc))
2217     (find (lambda (pred list)))
2218     (find$ (lambda (pred) proc))
2219     (find-module (lambda (id) env))
2220     (find-tail$ (lambda (pred) proc))
2221     (fixnum? (lambda (obj) bool))
2222     (flonum? (lambda (obj) bool))
2223     (fluid-let (syntax))
2224     (flush (lambda (:optional output-port) undefined))
2225     (flush-all-ports (lambda () undefined))
2226     (fmod (lambda (x1 x2) x))
2227     (fold (lambda (proc init list)))
2228     (fold$ (lambda (proc :optional init) proc))
2229     (fold-right (lambda (proc init list)))
2230     (fold-right$ (lambda (proc :optional init)))
2231     (for-each$ (lambda (proc) (lambda (ls) undefined)))
2232     (foreign-pointer-attribute-get (lambda (ptr attr)))
2233     (foreign-pointer-attribute-set (lambda (ptr attr val)))
2234     (foreign-pointer-attributes (lambda (ptr) list))
2235     (format (lambda (fmt-string arg |...|)))
2236     (format/ss (lambda (fmt-string arg |...|)))
2237     (frexp (lambda (x) x))
2238     (gauche-architecture (lambda () string))
2239     (gauche-architecture-directory (lambda () string))
2240     (gauche-character-encoding (lambda () symbol))
2241     (gauche-dso-suffix (lambda () string))
2242     (gauche-library-directory (lambda () string))
2243     (gauche-site-architecture-directory (lambda () string))
2244     (gauche-site-library-directory (lambda () string))
2245     (gauche-version (lambda () string))
2246     (gc (lambda () undefined))
2247     (gc-stat (lambda () list))
2248     (gensym (lambda (:optional name) symbol))
2249     (get-keyword (lambda (id list :optional default)))
2250     (get-keyword* (syntax))
2251     (get-optional (syntax))
2252     (get-output-string (lambda (string-output-port) string))
2253     (get-remaining-input-string (lambda (port) string))
2254     (get-signal-handler (lambda (n) proc))
2255     (get-signal-handler-mask (lambda (n) n))
2256     (get-signal-handlers (lambda () list))
2257     (get-signal-pending-limit (lambda () n))
2258     (getter-with-setter (lambda (get-proc set-proc) proc))
2259     (global-variable-bound? (lambda (sym) bool))
2260     (global-variable-ref (lambda (sym)))
2261     (guard (syntax))
2262     (has-setter? (lambda (proc) bool))
2263     (hash (lambda (obj)))
2264     (hash-table (lambda (id pair |...|) hash-table))
2265     (hash-table-delete! (lambda (hash-table key) undefined))
2266     (hash-table-exists? (lambda (hash-table key) bool))
2267     (hash-table-fold (lambda (hash-table proc init)))
2268     (hash-table-for-each (lambda (hash-table proc) undefined))
2269     (hash-table-get (lambda (hash-table key :optional default)))
2270     (hash-table-keys (lambda (hash-table) list))
2271     (hash-table-map (lambda (hash-table proc) list))
2272     (hash-table-num-entries (lambda (hash-table) n))
2273     (hash-table-pop! (lambda (hash-table key :optional default)))
2274     (hash-table-push! (lambda (hash-table key value) undefined))
2275     (hash-table-put! (lambda (hash-table key value) undefined))
2276     (hash-table-stat (lambda (hash-table) list))
2277     (hash-table-type (lambda (hash-table) id))
2278     (hash-table-update! (lambda (hash-table key proc :optional default) undefined))
2279     (hash-table-values (lambda (hash-table) list))
2280     (hash-table? (lambda (obj) bool))
2281     (identifier->symbol (lambda (obj) sym))
2282     (identifier? (lambda (obj) bool))
2283     (identity (lambda (obj)))
2284     (import (syntax))
2285     (inc! (syntax))
2286     (inexact-/ (lambda (x1 x2) x))
2287     (initialize (lambda (obj)))
2288     (instance-slot-ref (lambda (obj id)))
2289     (instance-slot-set (lambda (obj id value)))
2290     (integer->digit (lambda (n) ch))
2291     (integer-length (lambda (n) n))
2292     (is-a? (lambda (obj class) bool))
2293     (keyword->string (lambda (id) string))
2294     (keyword? (lambda (obj) bool))
2295     (last-pair (lambda (pair) pair))
2296     (lazy (syntax))
2297     (ldexp (lambda (x n) x))
2298     (let-keywords* (syntax))
2299     (let-optionals* (syntax))
2300     (let/cc (syntax))
2301     (let1 (syntax))
2302     (library-exists? (lambda (filename) bool))
2303     (library-fold (lambda (string proc init)))
2304     (library-for-each (lambda (string proc) undefined))
2305     (library-has-module? (lambda (filename id) bool))
2306     (library-map (lambda (string proc) list))
2307     (list* (lambda (obj |...|) list))
2308     (list-copy (lambda (list) list))
2309     (logand (lambda (n |...|) n))
2310     (logbit? (lambda (index n) bool))
2311     (logcount (lambda (n) n))
2312     (logior (lambda (n |...|) n))
2313     (lognot (lambda (n) n))
2314     (logtest (lambda (n |...|) bool))
2315     (logxor (lambda (n |...|) n))
2316     (macroexpand (lambda (obj)))
2317     (macroexpand-1 (lambda (obj)))
2318     (make (lambda (class args |...|)))
2319     (make-byte-string (lambda (n :optional int) byte-string))
2320     (make-compound-condition (lambda (condition |...|) condition))
2321     (make-condition (lambda (condition-type field+value |...|) condition))
2322     (make-condition-type (lambda (id condition-type list) condition-type))
2323     (make-hash-table (lambda (:optional id) hash-table))
2324     (make-keyword (lambda (string) sym))
2325     (make-list (lambda (n :optional init) list))
2326     (make-module (lambda (id :optional if-exists-proc) env))
2327     (make-weak-vector (lambda (n) vector))
2328     (map$ (lambda (proc) proc))
2329     (member$ (lambda (obj) proc))
2330     (merge (lambda (list1 list2 proc) list))
2331     (merge! (lambda (list1 list2 proc) list))
2332     (method-more-specific? (lambda (method1 method2 list) bool))
2333     (min&max (lambda (x |...|) (values x1 x2)))
2334     (modf (lambda (x) x))
2335     (module-exports (lambda (env) list))
2336     (module-imports (lambda (env) list))
2337     (module-name (lambda (env) sym))
2338     (module-name->path (lambda (sym) string))
2339     (module-parents (lambda (env) list))
2340     (module-precedence-list (lambda (env) list))
2341     (module-table (lambda (env) hash-table))
2342     (module? (lambda (obj) bool))
2343     (null-list? (lambda (obj) bool))
2344     (object-* (lambda (z |...|) z))
2345     (object-+ (lambda (z |...|) z))
2346     (object-- (lambda (z |...|) z))
2347     (object-/ (lambda (z |...|) z))
2348     (object-apply (lambda (proc arg |...|)))
2349     (object-compare (lambda (obj1 obj2) n))
2350     (object-equal? (lambda (obj1 obj2) bool))
2351     (object-hash (lambda (obj) n))
2352     (open-coding-aware-port (lambda (input-port) input-port))
2353     (open-input-buffered-port (lambda ()))
2354     (open-input-fd-port (lambda (fileno) input-port))
2355     (open-input-string (lambda (str) input-port))
2356     (open-output-buffered-port (lambda ()))
2357     (open-output-fd-port (lambda (fileno) output-port))
2358     (open-output-string (lambda () string-output-port))
2359     (pa$ (lambda (proc arg |...|) proc))
2360     (partition$ (lambda (pred) proc))
2361     (path->module-name (lambda (str) sym))
2362     (peek-byte (lambda (:optional input-port) n))
2363     (pop! (syntax (list)))
2364     (port->byte-string (lambda (input-port) byte-string))
2365     (port->list (lambda (proc input-port) list))
2366     (port->sexp-list (lambda (port) list))
2367     (port->string (lambda (port) string))
2368     (port->string-list (lambda (port) list))
2369     (port-buffering (lambda (port) sym))
2370     (port-closed? (lambda (port) bool))
2371     (port-current-line (lambda (port) n))
2372     (port-file-number (lambda (port) n))
2373     (port-fold (lambda (proc init port)))
2374     (port-fold-right (lambda (proc init port)))
2375     (port-for-each (lambda (proc read-proc) undefined))
2376     (port-map (lambda (proc read-proc)))
2377     (port-name (lambda (port) name))
2378     (port-position-prefix (lambda ()))
2379     (port-seek (lambda (port offset (set int SEEK_SET SEEK_CUR SEEK_END))))
2380     (port-tell (lambda (port) n))
2381     (port-type (lambda (port) sym))
2382     (print (lambda (obj |...|)))
2383     (procedure-arity-includes? (lambda (proc n) bool))
2384     (procedure-info (lambda (proc)))
2385     (profiler-reset (lambda () undefined))
2386     (profiler-show (lambda () undefined))
2387     (profiler-show-load-stats (lambda () undefined))
2388     (profiler-start (lambda () undefined))
2389     (profiler-stop (lambda () undefined))
2390     (program (syntax))
2391     (promise-kind (lambda ()))
2392     (promise? (lambda (obj) bool))
2393     (proper-list? (lambda (obj) bool))
2394     (provide (lambda (str) undefined))
2395     (provided? (lambda (str) bool))
2396     (push! (syntax))
2397     (quotient&remainder (lambda (n1 n2) (values n1 n2)))
2398     (raise (lambda (exn) undefined))
2399     (read-block (lambda (n :optional input-port) string))
2400     (read-byte (lambda (:optional input-port) n))
2401     (read-eval-print-loop (lambda () undefined))
2402     (read-from-string (lambda (str)))
2403     (read-line (lambda (:optional input-port) str))
2404     (read-list (lambda (ch :optional input-port)))
2405     (read-reference-has-value? (lambda ()))
2406     (read-reference-value (lambda ()))
2407     (read-reference? (lambda ()))
2408     (read-with-shared-structure (lambda (:optional input-port)))
2409     (read/ss (lambda (:optional input-port)))
2410     (rec (syntax))
2411     (receive (syntax))
2412     (redefine-class! (lambda ()))
2413     (reduce$ (lambda (proc :optional default) proc))
2414     (reduce-right$ (lambda (proc :optional default) proc))
2415     (ref (lambda (obj key |...|)))
2416     (ref* (lambda (obj key |...|)))
2417     (regexp->string (lambda (regexp) string))
2418     (regexp-case-fold? (lambda (regexp) bool))
2419     (regexp-compile (lambda (str) regexp))
2420     (regexp-optimize (lambda (str) str))
2421     (regexp-parse (lambda (str) list))
2422     (regexp-quote (lambda (str) str))
2423     (regexp-replace (lambda (regexp string subst) string))
2424     (regexp-replace* (lambda (string regexp subst |...|) string))
2425     (regexp-replace-all (lambda (regexp string subst) string))
2426     (regexp-replace-all* (lambda (string regexp subst |...|)))
2427     (regexp? (lambda (obj) bool))
2428     (regmatch? (lambda (obj) bool))
2429     (remove$ (lambda (pred) proc))
2430     (report-error (lambda ()))
2431     (require (syntax))
2432     (require-extension (syntax))
2433     (reverse! (lambda (list) list))
2434     (rxmatch (lambda (regexp string) regmatch))
2435     (rxmatch-after (lambda (regmatch :optional i) str))
2436     (rxmatch-before (lambda (regmatch :optional i) str))
2437     (rxmatch-case (syntax))
2438     (rxmatch-cond (syntax))
2439     (rxmatch-end (lambda (regmatch :optional i) n))
2440     (rxmatch-if (syntax))
2441     (rxmatch-let (syntax))
2442     (rxmatch-num-matches (lambda (regmatch) i))
2443     (rxmatch-start (lambda (regmatch :optional i) n))
2444     (rxmatch-substring (lambda (regmatch :optional i) str))
2445     (seconds->time (lambda (x) time))
2446     (select-module (syntax))
2447     (set!-values (syntax))
2448     (set-signal-handler! (lambda (signals handler) undefined))
2449     (set-signal-pending-limit (lambda (n) undefined))
2450     (setter (lambda (proc) proc))
2451     (sinh (lambda (z) z))
2452     (slot-bound-using-accessor? (lambda (proc obj id) bool))
2453     (slot-bound-using-class? (lambda (class obj id) bool))
2454     (slot-bound? (lambda (obj id) bool))
2455     (slot-definition-accessor (lambda ()))
2456     (slot-definition-allocation (lambda ()))
2457     (slot-definition-getter (lambda ()))
2458     (slot-definition-name (lambda ()))
2459     (slot-definition-option (lambda ()))
2460     (slot-definition-options (lambda ()))
2461     (slot-definition-setter (lambda ()))
2462     (slot-exists-using-class? (lambda (class obj id) bool))
2463     (slot-exists? (lambda (obj id) bool))
2464     (slot-initialize-using-accessor! (lambda ()))
2465     (slot-missing (lambda (class obj id)))
2466     (slot-push! (lambda (obj id value) undefined))
2467     (slot-ref (lambda (obj id)))
2468     (slot-ref-using-accessor (lambda (proc obj id)))
2469     (slot-ref-using-class (lambda (class obj id)))
2470     (slot-set! (lambda (obj id value) undefined))
2471     (slot-set-using-accessor! (lambda (proc obj id value) undefined))
2472     (slot-set-using-class! (lambda (class obj id value) undefined))
2473     (slot-unbound (lambda (class obj id)))
2474     (sort (lambda (seq :optional proc)))
2475     (sort! (lambda (seq :optional proc)))
2476     (sort-applicable-methods (lambda ()))
2477     (sorted? (lambda (seq :optional proc)))
2478     (split-at (lambda (list i) (values list list)))
2479     (stable-sort (lambda (seq :optional proc)))
2480     (stable-sort! (lambda (seq :optional proc)))
2481     (standard-error-port (lambda () output-port))
2482     (standard-input-port (lambda () input-port))
2483     (standard-output-port (lambda () output-port))
2484     (string->regexp (lambda (str) regexp))
2485     (string-byte-ref (lambda (str i) n))
2486     (string-byte-set! (lambda (str i n) undefined))
2487     (string-complete->incomplete (lambda (str) str))
2488     (string-immutable? (lambda (str) bool))
2489     (string-incomplete->complete (lambda (str) str))
2490     (string-incomplete->complete! (lambda (str) str))
2491     (string-incomplete? (lambda (str) bool))
2492     (string-interpolate (lambda (str) list))
2493     (string-join (lambda (list :optional delim-str (set grammar infix strict-infix prefix suffix))))
2494;; deprecated
2495;;      (string-pointer-byte-index (lambda ()))
2496;;      (string-pointer-copy (lambda ()))
2497;;      (string-pointer-index (lambda ()))
2498;;      (string-pointer-next! (lambda ()))
2499;;      (string-pointer-prev! (lambda ()))
2500;;      (string-pointer-ref (lambda ()))
2501;;      (string-pointer-set! (lambda ()))
2502;;      (string-pointer-substring (lambda ()))
2503;;      (string-pointer? (lambda ()))
2504     (string-scan (lambda (string item :optional (set return index before after before* after* both))))
2505     (string-size (lambda (str) n))
2506     (string-split (lambda (str splitter) list))
2507     (string-substitute! (lambda ()))
2508     (subr? (lambda (obj) bool))
2509     (supported-character-encoding? (lambda (id) bool))
2510     (supported-character-encodings (lambda () list))
2511     (symbol-bound? (lambda (id) bool))
2512     (syntax-error (syntax))
2513     (syntax-errorf (syntax))
2514     (sys-abort (lambda () undefined))
2515     (sys-access (lambda (filename (flags amode R_OK W_OK X_OK F_OK))))
2516     (sys-alarm (lambda (x) x))
2517     (sys-asctime (lambda (time) str))
2518     (sys-basename (lambda (filename) str))
2519     (sys-chdir (lambda (dirname)))
2520     (sys-chmod (lambda (filename n)))
2521     (sys-chown (lambda (filename uid gid)))
2522     (sys-close (lambda (fileno)))
2523     (sys-crypt (lambda (key-str salt-str) str))
2524     (sys-ctermid (lambda () string))
2525     (sys-ctime (lambda (time) string))
2526     (sys-difftime (lambda (time1 time2) x))
2527     (sys-dirname (lambda (filename) string))
2528     (sys-exec (lambda (command-string list) n))
2529     (sys-exit (lambda (n) undefined))
2530     (sys-fchmod (lambda (port-or-fileno n)))
2531     (sys-fdset-max-fd (lambda (fdset)))
2532     (sys-fdset-ref (lambda (fdset port-or-fileno)))
2533     (sys-fdset-set! (lambda (fdset port-or-fileno)))
2534     (sys-fork (lambda () n))
2535     (sys-fork-and-exec (lambda (command-string list) n))
2536     (sys-fstat (lambda (port-or-fileno) sys-stat))
2537     (sys-ftruncate (lambda (port-or-fileno n)))
2538     (sys-getcwd (lambda () string))
2539     (sys-getdomainname (lambda () string))
2540     (sys-getegid (lambda () gid))
2541     (sys-getenv (lambda (name) string))
2542     (sys-geteuid (lambda () uid))
2543     (sys-getgid (lambda () gid))
2544     (sys-getgrgid (lambda () gid))
2545     (sys-getgrnam (lambda (name)))
2546     (sys-getgroups (lambda () list))
2547     (sys-gethostname (lambda () string))
2548     (sys-getloadavg (lambda () list))
2549     (sys-getlogin (lambda () string))
2550     (sys-getpgid (lambda () gid))
2551     (sys-getpgrp (lambda () gid))
2552     (sys-getpid (lambda () pid))
2553     (sys-getppid (lambda () pid))
2554     (sys-getpwnam (lambda (name)))
2555     (sys-getpwuid (lambda () uid))
2556     (sys-gettimeofday (lambda () (values x1 x2)))
2557     (sys-getuid (lambda () uid))
2558     (sys-gid->group-name (lambda (gid) name))
2559     (sys-glob (lambda (string) list))
2560     (sys-gmtime (lambda (time) string))
2561     (sys-group-name->gid (lambda (name) gid))
2562     (sys-isatty (lambda (port-or-fileno) bool))
2563     (sys-kill (lambda (pid)))
2564     (sys-lchown (lambda (filename uid gid)))
2565     (sys-link (lambda (old-filename new-filename)))
2566     (sys-localeconv (lambda () alist))
2567     (sys-localtime (lambda (time) string))
2568     (sys-lstat (lambda (filename) sys-stat))
2569     (sys-mkdir (lambda (dirname)))
2570     (sys-mkfifo (lambda (filename)))
2571     (sys-mkstemp (lambda (filename)))
2572     (sys-mktime (lambda (time) x))
2573     (sys-nanosleep (lambda (x)))
2574     (sys-normalize-pathname (lambda (filename) string))
2575     (sys-pause (lambda (x)))
2576     (sys-pipe (lambda (:optional buffering) (values input-port output-port)))
2577     (sys-putenv (lambda (name string)))
2578     (sys-random (lambda () n))
2579     (sys-readdir (lambda (dirname) list))
2580     (sys-readlink (lambda (filename) string))
2581     (sys-realpath (lambda (filename) string))
2582     (sys-remove (lambda (filename)))
2583     (sys-rename (lambda (old-filename new-filename)))
2584     (sys-rmdir (lambda (dirname)))
2585     (sys-select (lambda (read-filenos write-filenos execpt-filenos :optional timeout-x)))
2586     (sys-select! (lambda (read-filenos write-filenos execpt-filenos :optional timeout-x)))
2587     (sys-setenv (lambda (name string)))
2588     (sys-setgid (lambda (gid)))
2589     (sys-setlocale (lambda (locale-string)))
2590     (sys-setpgid (lambda (gid)))
2591     (sys-setsid (lambda ()))
2592     (sys-setuid (lambda (uid)))
2593     (sys-sigmask (lambda ((set how SIG_SETMASK SIG_BLOCK SIG_UNBLOCK) sigset)))
2594     (sys-signal-name (lambda (n)))
2595     (sys-sigset (lambda (n |...|) sigset))
2596     (sys-sigset-add! (lambda (sigset n)))
2597     (sys-sigset-delete! (lambda (sigset n)))
2598     (sys-sigset-empty! (lambda (sigset)))
2599     (sys-sigset-fill! (lambda (sigset)))
2600     (sys-sigsuspend (lambda (sigset)))
2601     (sys-sigwait (lambda (sigset)))
2602     (sys-sleep (lambda (x)))
2603     (sys-srandom (lambda (n)))
2604     (sys-stat (lambda (filename)))
2605;; deprecated
2606;;      (sys-stat->atime (lambda ()))
2607;;      (sys-stat->ctime (lambda ()))
2608;;      (sys-stat->dev (lambda ()))
2609;;      (sys-stat->file-type (lambda ()))
2610;;      (sys-stat->gid (lambda ()))
2611;;      (sys-stat->ino (lambda ()))
2612;;      (sys-stat->mode (lambda ()))
2613;;      (sys-stat->mtime (lambda ()))
2614;;      (sys-stat->nlink (lambda ()))
2615;;      (sys-stat->rdev (lambda ()))
2616;;      (sys-stat->size (lambda ()))
2617;;      (sys-stat->type (lambda ()))
2618;;      (sys-stat->uid (lambda ()))
2619     (sys-strerror (lambda (errno) string))
2620     (sys-strftime (lambda (format-string time)))
2621     (sys-symlink (lambda (old-filename new-filename)))
2622     (sys-system (lambda (command) n))
2623     (sys-time (lambda () n))
2624     (sys-times (lambda () list))
2625;;      (sys-tm->alist (lambda ()))
2626     (sys-tmpnam (lambda () string))
2627     (sys-truncate (lambda (filename n)))
2628     (sys-ttyname (lambda (port-or-fileno) string))
2629     (sys-uid->user-name (lambda (uid) name))
2630     (sys-umask (lambda () n))
2631     (sys-uname (lambda () string))
2632     (sys-unlink (lambda (filename)))
2633     (sys-unsetenv (lambda (name)))
2634     (sys-user-name->uid (lambda (name) uid))
2635     (sys-utime (lambda (filename)))
2636     (sys-wait (lambda ()))
2637     (sys-wait-exit-status (lambda (n) n))
2638     (sys-wait-exited? (lambda (n) bool))
2639     (sys-wait-signaled? (lambda (n) bool))
2640     (sys-wait-stopped? (lambda (n) bool))
2641     (sys-wait-stopsig (lambda (n) n))
2642     (sys-wait-termsig (lambda (n) n))
2643     (sys-waitpid (lambda (pid)))
2644     (tanh (lambda (z) z))
2645     (time (syntax))
2646     (time->seconds (lambda (time) x))
2647     (time? (lambda (obj) bool))
2648     (toplevel-closure? (lambda (obj) bool))
2649     (touch-instance! (lambda ()))
2650     (ucs->char (lambda (n) ch))
2651     (undefined (lambda () undefined))
2652     (undefined? (lambda (obj) bool))
2653     (unless (syntax))
2654     (until (syntax))
2655     (unwrap-syntax (lambda (obj)))
2656     (update! (syntax))
2657     (update-direct-method! (lambda ()))
2658     (update-direct-subclass! (lambda ()))
2659     (use (special symbol gauche-available-modules))
2660     (use-version (syntax))
2661     (values-ref (syntax))
2662     (vector-copy (lambda (vector :optional start end fill) vector))
2663     (vm-dump (lambda () undefined))
2664     (vm-get-stack-trace (lambda () undefined))
2665     (vm-get-stack-trace-lite (lambda () undefined))
2666     (vm-set-default-exception-handler (lambda (handler) undefined))
2667     (warn (lambda (message-str args) undefined))
2668     (weak-vector-length (lambda (vector) n))
2669     (weak-vector-ref (lambda (vector i)))
2670     (weak-vector-set! (lambda (vector i value) undefined))
2671     (when (syntax))
2672     (while (syntax))
2673     (with-error-handler (lambda (handler thunk)))
2674     (with-error-to-port (lambda (port thunk)))
2675     (with-exception-handler (lambda (handler thunk)))
2676     (with-input-from-port (lambda (port thunk)))
2677     (with-input-from-string (lambda (string thunk)))
2678     (with-module (syntax))
2679     (with-output-to-port (lambda (port thunk)))
2680     (with-output-to-string (lambda (thunk) string))
2681     (with-port-locking (lambda (port thunk)))
2682     (with-ports (lambda (input-port output-port error-port thunk)))
2683     (with-signal-handlers (syntax))
2684     (with-string-io (lambda (string thunk) string))
2685     (write* (lambda (obj :optional output-port) undefined))
2686     (write-byte (lambda (n :optional output-port) undefined))
2687     (write-limited (lambda (obj :optional output-port)))
2688     (write-object (lambda (obj output-port)))
2689     (write-to-string (lambda (obj) string))
2690     (write-with-shared-structure (lambda (obj :optional output-port)))
2691     (write/ss (lambda (obj :optional output-port)))
2692     (x->integer (lambda (obj) integer))
2693     (x->number (lambda (obj) number))
2694     (x->string (lambda (obj) string))
2695     )))
2696
2697;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2698;; special lookups (XXXX add more impls, try to abstract better)
2699
2700(defvar *chicken-base-repo*
2701  (or (getenv "CHICKEN_REPOSITORY")
2702      (let ((dir
2703             (car (remove-if-not #'file-directory-p
2704                                 '("/usr/lib/chicken"
2705                                   "/usr/local/lib/chicken"
2706                                   "/opt/lib/chicken"
2707                                   "/opt/local/lib/chicken")))))
2708        (and dir
2709             (car (reverse (sort (directory-files dir t "^[0-9]+$")
2710                                 #'string-lessp)))))
2711      (and (fboundp 'shell-command-to-string)
2712           (let* ((res (shell-command-to-string "chicken-setup -R"))
2713                  (res (substring res 0 (- (length res) 1))))
2714             (and res (file-directory-p res) res)))
2715      "/usr/local/lib/chicken"))
2716
2717(defvar *chicken-repo-dirs*
2718  (remove-if-not
2719   #'(lambda (x) (and (stringp x) (not (equal x ""))))
2720   (let ((home (getenv "CHICKEN_HOME")))
2721     (if (and home (not (equal home "")))
2722         (let ((res (split-string home ";")))
2723           (if (member *chicken-repo-dirs* res)
2724               res
2725             (cons *chicken-repo-dirs* res))) 
2726       (list *chicken-base-repo*)))))
2727
2728(defun chicken-available-modules (&optional sym)
2729  (append
2730   (mapcar #'symbol-name (mapcar #'car *scheme-chicken-modules*))
2731   (mapcar
2732    #'file-name-sans-extension
2733    (directory-files "." nil ".*\\.scm$" t))
2734   (append-map
2735    #'(lambda (dir)
2736        (mapcar
2737         #'file-name-sans-extension
2738         (directory-files dir nil ".*\\.\\(so\\|scm\\)$" t)))
2739    *chicken-repo-dirs*)))
2740
2741(defvar *gauche-repo-path*
2742  (or (car (remove-if-not #'file-directory-p
2743                          '("/usr/share/gauche"
2744                            "/usr/local/share/gauche"
2745                            "/opt/share/gauche"
2746                            "/opt/local/share/gauche")))
2747      (and (fboundp 'shell-command-to-string)
2748           (let* ((res (shell-command-to-string "gauche-config --syslibdir"))
2749                  (res (substring res 0 (- (length res) 1))))
2750             (and res (file-directory-p res) res)))
2751      "/usr/local/share/gauche"))
2752
2753(defvar *gauche-site-repo-path*
2754  (concat *gauche-repo-path* "/site/lib"))
2755
2756(defun gauche-available-modules (&optional sym)
2757  (let ((version-dir (concat
2758                      (car (directory-files *gauche-repo-path* t "^[0-9]"))
2759                      "/lib"))
2760        (site-dir *gauche-site-repo-path*)
2761        (other-dirs
2762         (remove-if-not
2763          #'(lambda (d) (and (not (equal d "")) (file-directory-p d)))
2764          (split-string (or (getenv "GAUCHE_LOAD_PATH") "") ":"))))
2765    (mapcar
2766     #'(lambda (f) (subst-char-in-string ?/ ?. f))
2767     (mapcar
2768      #'file-name-sans-extension
2769      (append-map
2770       #'(lambda (dir)
2771           (let ((len (length dir)))
2772             (mapcar #'(lambda (f) (substring f (+ 1 len)))
2773                     (directory-tree-files dir t "\\.scm"))))
2774       (cons version-dir (cons site-dir other-dirs)))))))
2775
2776;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2777;; utilities
2778
2779(defun append-map (proc init-ls)
2780  (if (null init-ls)
2781      '()
2782    (let* ((ls (reverse init-ls))
2783           (res (funcall proc (pop ls))))
2784      (while (consp ls)
2785        (setq res (append (funcall proc (pop ls)) res)))
2786      res)))
2787
2788(defun flatten (ls)
2789  (cond
2790   ((consp ls) (cons (car ls) (flatten (cdr ls))))
2791   ((null ls) '())
2792   (t (list ls))))
2793
2794(defun scheme-in-string-p ()
2795  (let ((orig (point)))
2796    (save-excursion
2797      (goto-char (point-min))
2798      (let ((parses (parse-partial-sexp (point) orig)))
2799        (nth 3 parses)))))
2800
2801(defun scheme-beginning-of-sexp ()
2802  (let ((syn (char-syntax (char-before (point)))))
2803    (if (or (eq syn ?\()
2804            (and (eq syn ?\") (scheme-in-string-p)))
2805        (forward-char -1)
2806      (forward-sexp -1))))
2807
2808(defun find-file-in-path (file path)
2809  (car (remove-if-not
2810        #'(lambda (dir) (file-exists-p (concat dir file)))
2811        path)))
2812
2813;; visit a file and kill the buffer only if it wasn't already open
2814(defmacro with-find-file (path-expr &rest body)
2815  (let ((path (gensym))
2816        (buf (gensym))
2817        (res (gensym)))
2818    `(save-window-excursion
2819       (let* ((,path (file-truename ,path-expr))
2820              (,buf (find-if #'(lambda (x) (equal ,path (buffer-file-name x)))
2821                             (buffer-list))))
2822         (if ,buf
2823             (switch-to-buffer ,buf)
2824           (find-file ,path))
2825         (let ((,res (save-excursion ,@body)))
2826           (unless ,buf (kill-buffer (current-buffer)))
2827           ,res)))))
2828
2829(defun directory-tree-files (init-dir &optional full match)
2830  (let ((res '())
2831        (stack (list init-dir)))
2832    (while (consp stack)
2833      (let* ((dir (pop stack))
2834             (files (cddr (directory-files dir full))))
2835        (setq res (append (if match
2836                              (remove-if-not
2837                               #'(lambda (f) (string-match match f))
2838                               files)
2839                            files)
2840                          res))
2841        (setq stack
2842              (append
2843               (remove-if-not 'file-directory-p
2844                              (if full
2845                                  files
2846                                (mapcar #'(lambda (f) (concat dir "/" f))
2847                                        files)))
2848               stack))))
2849    res))
2850
2851;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2852;; sexp manipulation
2853
2854;; returns current argument position within sexp
2855(defun beginning-of-current-sexp-operator ()
2856  (let ((pos 0))
2857    (skip-syntax-backward "w_")
2858    (while (and (not (bobp)) (not (eq ?\( (char-before))))
2859      (scheme-beginning-of-sexp)
2860      (incf pos))
2861    pos))
2862
2863(defun beginning-of-next-sexp ()
2864  (forward-sexp 2)
2865  (backward-sexp 1))
2866
2867(defun beginning-of-string ()
2868  (interactive)
2869  (search-backward "\"" nil t)
2870  (while (and (> (point) (point-min)) (eq ?\\ (char-before)))
2871    (search-backward "\"" nil t)))
2872
2873;; for the enclosing sexp, returns a cons of the leading symbol (if
2874;; any) and the current position within the sexp (starting at 0)
2875(defun enclosing-sexp-prefix ()
2876  (save-excursion
2877    (let ((pos (beginning-of-current-sexp-operator)))
2878      (cons (scheme-symbol-at-point) pos))))
2879
2880(defun enclosing-2-sexp-prefixes ()
2881  (save-excursion
2882    (let* ((pos1 (beginning-of-current-sexp-operator))
2883           (sym1 (scheme-symbol-at-point)))
2884      (backward-char)
2885      (or
2886       (ignore-errors
2887         (let ((pos2 (beginning-of-current-sexp-operator)))
2888           (list sym1 pos1 (scheme-symbol-at-point) pos2)))
2889       (list sym1 pos1 nil 0)))))
2890
2891;; sexp-at-point is always fragile, both because the user can input
2892;; incomplete sexps and because some scheme sexps are not valid elisp
2893;; sexps.  this is one of the few places we use it, so we're careful
2894;; to wrap it in ignore-errors.
2895(defun nth-sexp-at-point (n)
2896  (ignore-errors
2897    (save-excursion
2898      (forward-sexp (+ n 1))
2899      (let ((end (point)))
2900        (forward-sexp -1)
2901        (car (read-from-string (buffer-substring (point) end)))))))
2902
2903(defun scheme-symbol-at-point ()
2904  (save-excursion
2905    (skip-syntax-backward "w_")
2906    (let ((start (point)))
2907      (skip-syntax-forward "w_")
2908      (and (< start (point))
2909           (intern (buffer-substring start (point)))))))
2910
2911(defun goto-next-top-level ()
2912  (let ((here (point)))
2913    (or (ignore-errors (end-of-defun) (end-of-defun)
2914                       (beginning-of-defun)
2915                       (not (eq here (point))))
2916        (progn (forward-char) (re-search-forward "^(" nil t))
2917        (goto-char (point-max)))))
2918
2919;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2920;; variable extraction
2921
2922(defun sexp-type-at-point (&optional env)
2923  (case (char-syntax (char-after))
2924    ((?\()
2925     (forward-char 1)
2926     (if (eq ?w (char-syntax (char-after)))
2927         (let ((op (scheme-symbol-at-point)))
2928           (cond
2929            ((eq op 'lambda)
2930             (let ((params
2931                    (nth-sexp-at-point 1)))
2932               `(lambda ,params)))
2933            (t
2934             (let ((spec (scheme-env-lookup env op)))
2935               (and spec
2936                    (consp (cadr spec))
2937                    (eq 'lambda (caadr spec))
2938                    (cddadr spec)
2939                    (car (cddadr spec)))))))
2940       nil))
2941    ((?\")
2942     'string)
2943    ((?\w)
2944     (if (string-match "[0-9]" (string (char-after)))
2945         'number
2946       nil))
2947    (t
2948     nil)))
2949
2950(defun let-vars-at-point (&optional env)
2951  (let ((end (save-excursion (forward-sexp) (point)))
2952        (vars '()))
2953    (forward-char 1)
2954    (while (< (point) end)
2955      (when (eq ?\( (char-after))
2956        (save-excursion
2957          (forward-char 1)
2958          (if (eq ?w (char-syntax (char-after)))
2959              (let* ((sym (scheme-symbol-at-point))
2960                     (type (ignore-errors
2961                             (beginning-of-next-sexp)
2962                             (sexp-type-at-point env))))
2963                (push (if type (list sym type) (list sym)) vars)))))
2964      (or (ignore-errors (progn (beginning-of-next-sexp) t))
2965          (goto-char end)))
2966    (reverse vars)))
2967
2968(defun extract-match-clause-vars (x)
2969  (cond
2970   ((null x) '())
2971   ((symbolp x)
2972    (if (memq x '(_ ___ |...|))
2973        '()
2974      (list x)))
2975   ((consp x)
2976    (case (car x)
2977      ((and or not)
2978       (extract-match-clause-vars (cdr x)))
2979      ((? = $)
2980       (if (consp (cdr x)) (extract-match-clause-vars (cddr x)) '()))
2981      ((get! set!)
2982       (if (consp (cdr x)) (extract-match-clause-vars (cadr x)) '()))
2983      ((quote) '())
2984      ((quasiquote) '()) ; XXXX
2985      (t (union (extract-match-clause-vars (car x))
2986                (extract-match-clause-vars (cdr x))))))
2987   ((vectorp x)
2988    (extract-match-clause-vars (concatenate 'list x)))
2989   (t
2990    '())))
2991
2992(defun extract-match-vars (ls)
2993  (apply 'append (mapcar 'extract-match-clause-vars
2994                         (mapcar 'car (remove-if-not 'consp ls)))))
2995
2996;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2997;; You can set the *default-scheme-implementation* to your preferred
2998;; implementation, for when we can't figure out the file from
2999;; heuristics.  Alternately, in any given buffer, just
3000;;
3001;; (setq *current-scheme-implementation* whatever)
3002
3003(defgroup scheme-complete nil
3004  "Smart tab completion"
3005  :group 'scheme)
3006
3007(defcustom default-scheme-implementation nil
3008  "Default scheme implementation to provide completion for
3009when scheme-complete can't infer the current implementation."
3010  :type 'symbol
3011  :group 'scheme-complete)
3012
3013(defvar *current-scheme-implementation* nil)
3014(make-variable-buffer-local '*current-scheme-implementation*)
3015
3016;; most implementations use their name as the script name
3017(defvar *scheme-interpreter-alist*
3018  '(("csi" . chicken)
3019    ("gosh" . gauche)
3020    ("gsi" . gambit)
3021    ))
3022
3023(defun current-scheme-implementation ()
3024  (unless *current-scheme-implementation*
3025    (setq *current-scheme-implementation*
3026          (save-excursion
3027            (goto-char (point-min))
3028            (or (if (looking-at "#! *\\([^ ]+\\)")
3029                    (let ((script (file-name-nondirectory (match-string 1))))
3030                      (or (cdr (assoc script *scheme-interpreter-alist*))
3031                          (intern script))))
3032                (cond
3033                 ((re-search-forward "(define-module +\\(.\\)" nil t)
3034                  (if (equal "(" (match-string 1))
3035                      'guile
3036                    'gauche))
3037                 ((re-search-forward "(use " nil t)
3038                  'chicken)
3039                 ((re-search-forward "(module " nil t)
3040                  'mzscheme))))))
3041  (or *current-scheme-implementation*
3042      default-scheme-implementation))
3043
3044;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3045
3046(defun current-local-vars (&optional env)
3047  (let ((vars '())
3048        (limit (save-excursion (beginning-of-defun) (+ (point) 1)))
3049        (start (point))
3050        (scan-internal))
3051    (save-excursion
3052      (while (> (point) limit)
3053        (or (ignore-errors
3054              (progn
3055                (skip-chars-backward " \t\n" limit)
3056                (scheme-beginning-of-sexp)
3057                t))
3058            (goto-char limit))
3059        (when (and (> (point) (point-min))
3060                   (eq ?\( (char-syntax (char-before (point))))
3061                   (eq ?w (char-syntax (char-after (point)))))
3062          (setq scan-internal t)
3063          (let ((sym (scheme-symbol-at-point)))
3064            (case sym
3065              ((lambda)
3066               (setq vars
3067                     (append (mapcar #'list (flatten (nth-sexp-at-point 1)))
3068                             vars)))
3069              ((match)
3070               (setq vars (append
3071                           (mapcar #'list
3072                                   (flatten (extract-match-vars
3073                                             (nth-sexp-at-point 2))))
3074                           vars)))
3075              ((match-let match-let*)
3076               (setq vars (append (mapcar #'list
3077                                          (flatten (extract-match-vars
3078                                                    (nth-sexp-at-point 1))))
3079                                 vars)))
3080              ((let let* letrec letrec* let-syntax letrec-syntax and-let* do)
3081               (save-excursion
3082                 (beginning-of-next-sexp)
3083                 (if (and (eq sym 'let)
3084                          (eq ?w (char-syntax (char-after (point)))))
3085                     ;; named let
3086                     (let* ((sym (scheme-symbol-at-point))
3087                            (args (progn
3088                                    (beginning-of-next-sexp)
3089                                    (let-vars-at-point env))))
3090                       (setq vars (cons `(,sym (lambda ,(mapcar #'car args)))
3091                                        (append args vars))))
3092                   (setq vars (append (let-vars-at-point env) vars)))))
3093              ((let-values let*-values)
3094               (setq vars
3095                     (append (mapcar
3096                              #'list
3097                              (append-map
3098                               #'flatten
3099                               (remove-if-not 'consp (nth-sexp-at-point 1))))
3100                             vars)))
3101              ((receive defun defmacro)
3102               (setq vars
3103                     (append (mapcar #'list (flatten (nth-sexp-at-point 1)))
3104                             vars)))
3105              (t
3106               (if (string-match "^define\\(-.*\\)?" (symbol-name sym))
3107                   (let ((defs (save-excursion
3108                                 (backward-char)
3109                                 (scheme-extract-definitions))))
3110                     (setq vars
3111                           (append (append-map
3112                                    #'(lambda (x)
3113                                        (and (consp (cdr x))
3114                                             (consp (cadr x))
3115                                             (eq 'lambda (caadr x))
3116                                             (mapcar #'list
3117                                                     (flatten (cadadr x)))))
3118                                    defs)
3119                                   defs
3120                                   vars)))
3121                 (setq scan-internal nil))))
3122            ;; check for internal defines
3123            (when scan-internal
3124              (ignore-errors
3125                (save-excursion
3126                  (forward-sexp
3127                   (+ 1 (if (numberp scan-internal) scan-internal 2)))
3128                  (backward-sexp)
3129                  (if (< (point) start)
3130                      (setq vars (append (current-scheme-definitions) vars))
3131                    ))))))))
3132    (reverse vars)))
3133
3134(defun extract-import-module-name (sexp &optional mzschemep)
3135  (case (car sexp)
3136    ((prefix)
3137     (extract-import-module-name (if mzschemep (caddr sexp) (cadr sexp))))
3138    ((prefix-all-except)
3139     (extract-import-module-name (caddr sexp)))
3140    ((for only except rename lib library)
3141     (extract-import-module-name (cadr sexp) mzschemep))
3142    ((import)
3143     (extract-import-module-name (cadr sexp) mzschemep))
3144    ((require)
3145     (extract-import-module-name (cadr sexp) t))
3146    (t sexp)))
3147
3148(defun extract-import-module-imports (sexp &optional mzschemep)
3149  (case (car sexp)
3150    ((prefix)
3151     (let* ((ids (extract-import-module-name
3152                  (if mzschemep (caddr sexp) (cadr sexp))
3153                  mzschemep))
3154            (prefix0 (if mzschemep (cadr sexp) (caddr sexp)))
3155            (prefix (if (symbolp prefix0) (symbol-name prefix0) prefix0)))
3156       (mapcar #'(lambda (x) (intern (concat prefix (symbol-name x)))) ids)))
3157    ((prefix-all-except)
3158     (let ((prefix
3159            (if (symbolp (cadr sexp)) (symbol-name (cadr sexp)) (cadr sexp)))
3160           (exceptions (cddr sexp)))
3161       (mapcar #'(lambda (x)
3162                   (if (memq x exceptions)
3163                       x
3164                     (intern (concat prefix (symbol-name x)))))
3165               (extract-import-module-name (caddr sexp) t))))
3166    ((for)
3167     (extract-import-module-name (cadr sexp) mzschemep))
3168    ((rename)
3169     (if mzschemep
3170         (list (caddr sexp))
3171       (mapcar 'cadr (cddr sexp))))
3172    ((except)
3173     (remove-if #'(lambda (x) (memq x (cddr sexp)))
3174                (extract-import-module-imports (cadr sexp) mzschemep)))
3175    ((only)
3176     (cddr sexp))
3177    ((import)
3178     (extract-import-module-imports (cadr sexp) mzschemep))
3179    ((require for-syntax)
3180     (extract-import-module-imports (cadr sexp) t))
3181    ((library)
3182     (if (and (stringp (cadr sexp)) (file-exists-p (cadr sexp)))
3183         (scheme-module-exports (intern (cadr sexp)))))
3184    ((lib)
3185     (if (and (equal "srfi" (caddr sexp))
3186              (stringp (cadr sexp))
3187              (string-match "^[0-9]+\\." (cadr sexp)))
3188         (scheme-module-exports
3189          (intern (file-name-sans-extension (concat "srfi-" (cadr sexp)))))
3190       (scheme-module-exports
3191        (intern (apply 'concat (append (cddr sexp) (list (cadr sexp))))))))
3192    (t sexp)))
3193
3194(defun extract-sexp-imports (sexp)
3195  (case (car sexp)
3196    ((begin)
3197     (append-map #'extract-sexp-imports (cdr sexp)))
3198    ((cond-expand)
3199     (append-map #'extract-sexp-imports (append-map #'cdr (cdr sexp))))
3200    ((use require-extension)
3201     (append-map #'scheme-module-exports (cdr sexp)))
3202    ((autoload)
3203     (mapcar #'(lambda (x) (cons (if (consp x) (car x) x) '((lambda obj))))
3204             (cddr sexp)))
3205    ((load)
3206     (and (file-exists-p (cadr sexp))
3207          (with-find-file (cadr sexp)
3208            (current-scheme-globals))))
3209    ((library module)
3210     (append-map #'extract-import-module-imports
3211                 (remove-if #'(lambda (x) (memq (car x) '(import require)))
3212                            (cdr sexp))))
3213    (t '())))
3214
3215(defun module-symbol-p (sym)
3216  (memq sym '(use require require-extension begin cond-expand
3217              module library define-module autoload load)))
3218
3219(defun skip-shebang ()
3220  ;; skip shebang if present
3221  (if (looking-at "#!")
3222      ;; guile skips until a closing !#
3223      (if (eq 'guile (current-scheme-implementation))
3224          (re-search-forward "!#" nil t)
3225        (next-line))))
3226
3227(defun current-scheme-imports ()
3228  (let ((imports '()))
3229    (save-excursion
3230      (goto-char (point-min))
3231      (skip-shebang)
3232      ;; scan for module forms
3233      (while (not (eobp))
3234        (if (ignore-errors (progn (forward-sexp) t))
3235            (let ((end (point)))
3236              (backward-sexp)
3237              (when (eq ?\( (char-after))
3238                (forward-char)
3239                (when (and (not (eq ?\( (char-after)))
3240                           (module-symbol-p (scheme-symbol-at-point)))
3241                  (backward-char)
3242                  (ignore-errors
3243                    (setq imports
3244                          (append (extract-sexp-imports (nth-sexp-at-point 0))
3245                                  imports)))))
3246              (goto-char end))
3247          ;; if an incomplete sexp is found, try to recover at the
3248          ;; next line beginning with an open paren
3249          (goto-next-top-level))))
3250    imports))
3251
3252;; we should be just inside the opening paren of an expression
3253(defun scheme-name-of-define ()
3254  (save-excursion
3255    (beginning-of-next-sexp)
3256    (if (eq ?\( (char-syntax (char-after)))
3257        (forward-char))
3258    (and (memq (char-syntax (char-after)) '(?\w ?\_))
3259         (scheme-symbol-at-point))))
3260
3261(defun scheme-type-of-define ()
3262  (save-excursion
3263    (beginning-of-next-sexp)
3264    (cond
3265     ((eq ?\( (char-syntax (char-after)))
3266      `(lambda ,(cdr (nth-sexp-at-point 0))))
3267     (t
3268      (beginning-of-next-sexp)
3269      (sexp-type-at-point)))))
3270
3271;; we should be at the opening paren of an expression
3272(defun scheme-extract-definitions (&optional env)
3273  (save-excursion
3274    (let ((sym (ignore-errors (and (eq ?\( (char-syntax (char-after)))
3275                                   (progn (forward-char)
3276                                          (scheme-symbol-at-point))))))
3277      (case sym
3278        ((define-syntax defmacro define-macro)
3279         (list (list (scheme-name-of-define) '(syntax))))
3280        ((define define-inline define-constant define-primitive defun)
3281         (let ((name (scheme-name-of-define))
3282               (type (scheme-type-of-define)))
3283           (list (if type (list name type) (list name)))))
3284        ((defvar define-class)
3285         (list (list (scheme-name-of-define) 'non-procedure)))
3286        ((define-record)
3287         (backward-char)
3288         (ignore-errors
3289           (let* ((sexp (nth-sexp-at-point 0))
3290                  (name (symbol-name (cadr sexp))))
3291             `((,(intern (concat name "?")) (lambda (obj) boolean))
3292               (,(intern (concat "make-" name)) (lambda ,(cddr sexp) ))
3293               ,@(append-map
3294                  #'(lambda (x)
3295                      `((,(intern (concat name "-" (symbol-name x)))
3296                         (lambda (non-procedure)))
3297                        (,(intern (concat name "-" (symbol-name x) "-set!"))
3298                         (lambda (non-procedure val) undefined))))
3299                  (cddr sexp))))))
3300        ((define-record-type)
3301         (backward-char)
3302         (ignore-errors
3303           (let ((sexp (nth-sexp-at-point 0)))
3304             `((,(caaddr sexp) (lambda ,(cdaddr sexp)))
3305               (,(cadddr sexp) (lambda (obj)))
3306               ,@(append-map 
3307                  #'(lambda (x)
3308                      (if (consp x)
3309                          (if (consp (cddr x))
3310                              `((,(cadr x) (lambda (non-procedure)))
3311                                (,(caddr x)
3312                                 (lambda (non-procedure val) undefined)))
3313                            `((,(cadr x) (lambda (non-procedure)))))))
3314                  (cddddr sexp))))))
3315        ((begin progn)
3316         (forward-sexp)
3317         (current-scheme-definitions))
3318        (t
3319         '())))))
3320
3321;; a little more liberal than -definitions, we try to scan to a new
3322;; top-level form (i.e. a line beginning with an open paren) if
3323;; there's an error during normal sexp movement
3324(defun current-scheme-globals ()
3325  (let ((globals '()))
3326    (save-excursion
3327      (goto-char (point-min))
3328      (or (ignore-errors (end-of-defun) (beginning-of-defun) t)
3329          (re-search-forward "^(" nil t)
3330          (goto-char (point-max)))
3331      (while (not (eobp))
3332        (setq globals
3333              (append (scheme-extract-definitions) globals))
3334        (goto-next-top-level)))
3335    globals))
3336
3337;; for internal defines, etc.
3338(defun current-scheme-definitions (&optional enclosing-end)
3339  (let ((defs '())
3340        (end (or enclosing-end (point-max))))
3341    (save-excursion
3342      (while (< (point) end)
3343        (let ((new-defs (scheme-extract-definitions)))
3344          (cond
3345           (new-defs
3346             (setq defs (append new-defs defs))
3347             (or (ignore-errors (beginning-of-next-sexp) t)
3348                 (goto-char end)))
3349           (t ;; non-definition form, stop scanning
3350            (goto-char end))))))
3351    defs))
3352
3353(defun scheme-module-exports (mod)
3354  (if (not (symbolp mod))
3355      '()
3356    (cond
3357     ((string-match "^srfi-" (symbol-name mod))
3358      (let ((i (string-to-number (substring (symbol-name mod) 5))))
3359        (and (< i (length *scheme-srfi-info*))
3360             (let ((info (cdr (aref *scheme-srfi-info* i))))
3361               (if (and (consp info) (null (cdr info)) (symbolp (car info)))
3362                   (scheme-module-exports (car info))
3363                 info)))))
3364     (t
3365      (case (current-scheme-implementation)
3366        ((chicken)
3367         (let ((predefined (assq mod *scheme-chicken-modules*)))
3368           (if predefined
3369               (cdr predefined) 
3370             (mapcar
3371              #'(lambda (x) (cons x '((lambda obj))))
3372              (or (mapcar #'intern
3373                          (file->lines (concat "/usr/local/lib/chicken/3/"
3374                                               (symbol-name mod)
3375                                               ".exports")))
3376                  (let ((setup-info (concat "/usr/local/lib/chicken/3/"
3377                                            (symbol-name mod)
3378                                            ".setup-info")))
3379                    (and (file-exists-p setup-info)
3380                         (with-find-file setup-info
3381                           (let* ((alist (nth-sexp-at-point 0))
3382                                  (cell (assq 'exports alist)))
3383                             (cdr cell))))))))))
3384        ((gauche)
3385         (let ((path (find-file-in-path
3386                      (concat (subst-char-in-string ?. ?/ (symbol-name mod))
3387                              ".scm")
3388                      (list (concat
3389                             (car (directory-files
3390                                   "/usr/local/share/gauche/"
3391                                   t
3392                                   "^[0-9]"))
3393                             "/lib")
3394                            "/usr/local/share/gauche/site/lib"))))
3395           (if (not (file-exists-p path))
3396               '()
3397             ;; XXXX parse, don't use regexps
3398             (with-find-file path
3399               (when (re-search-forward "(export" nil t)
3400                 (backward-sexp)
3401                 (backward-char)
3402                 (mapcar #'list (cdr (ignore-errors
3403                                       (nth-sexp-at-point 0)))))))))
3404        ((mzscheme)
3405         (let ((path (find-file-in-path
3406                      (symbol-name mod)
3407                      '("."
3408                        "/usr/local/lib/plt/collects"
3409                        "/usr/local/lib/plt/collects/mzlib"))))
3410           (if (not (file-exists-p path))
3411               '()
3412             ;; XXXX parse, don't use regexps
3413             (with-find-file path
3414               (when (re-search-forward "(provide" nil t)
3415                 (backward-sexp)
3416                 (backward-char)
3417                 (mapcar #'list (cdr (ignore-errors
3418                                       (nth-sexp-at-point 0)))))))))
3419        (t '()))))))
3420
3421;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3422;; This is rather complicated because we to auto-generate docstring
3423;; summaries from the type information, which means inferring various
3424;; types from common names.  The benefit is that you don't have to
3425;; input the same information twice, and can often cut&paste&munge
3426;; procedure descriptions from the original documentation.
3427
3428(defun scheme-translate-type (type)
3429  (if (not (symbolp type))
3430      type
3431    (case type
3432      ((pred proc thunk handler dispatch producer consumer f fn g kons)
3433       'procedure)
3434      ((num) 'number)
3435      ((z) 'complex)
3436      ((x y timeout seconds nanoseconds) 'real)
3437      ((i j k n m int index size count len length bound nchars start end
3438        pid uid gid fd fileno errno)
3439       'integer)
3440      ((ch) 'char)
3441      ((str name pattern) 'string)
3442      ((file path pathname) 'filename)
3443      ((dir dirname) 'directory)
3444      ((sym id identifier) 'symbol)
3445      ((ls alist lists) 'list)
3446      ((vec) 'vector)
3447      ((exc excn err error) 'exception)
3448      ((ptr) 'pointer)
3449      ((bool) 'boolean)
3450      ((env) 'environment)
3451      ((char string boolean number complex real integer procedure char-set
3452        port input-port output-port pair list vector array stream hash-table
3453        thread mutex condition-variable time exception date duration locative
3454        random-source state condition condition-type queue sequence pointer
3455        u8vector s8vector u16vector s16vector u32vector s32vector
3456        u64vector s64vector f32vector f64vector undefined symbol
3457        block filename directory mmap listener environment non-procedure
3458        read-table continuation blob generic method class regexp regmatch
3459        sys-stat fdset)
3460       type)
3461      ((parent seed option mode) 'non-procedure)
3462      (t
3463       (let* ((str (symbol-name type))
3464              (i (string-match "-?[0-9]+$" str)))
3465         (if i
3466             (scheme-translate-type (intern (substring str 0 i)))
3467           (let ((i (string-match "-\\([^-]+\\)$" str)))
3468             (if i
3469                 (scheme-translate-type (intern (substring str (+ i 1))))
3470               (if (string-match "\\?$" str)
3471                   'boolean
3472                 'object)))))))))
3473
3474(defun scheme-lookup-type (spec pos)
3475  (let ((i 1)
3476        (type nil))
3477    (while (and (consp spec) (<= i pos))
3478      (cond
3479       ((eq :optional (car spec))
3480        (if (and (= i pos) (consp (cdr spec)))
3481            (setq type (cadr spec)))
3482        (setq i (+ pos 1)))
3483       ((= i pos)
3484        (setq type (car spec))
3485        (setq spec nil))
3486       ((and (consp (cdr spec)) (eq '|...| (cadr spec)))
3487        (setq type (car spec))
3488        (setq spec nil)))
3489      (setq spec (cdr spec))
3490      (incf i))
3491    (if type
3492        (setq type (scheme-translate-type type)))
3493    type))
3494
3495;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3496;; completion
3497
3498(eval-when (compile load eval)
3499  (unless (fboundp 'event-matches-key-specifier-p)
3500    (defalias 'event-matches-key-specifier-p 'eq)))
3501
3502(unless (fboundp 'read-event)
3503  (defun read-event ()
3504    (aref (read-key-sequence nil) 0)))
3505
3506(defun do-completion (str coll &optional strs pred)
3507  (let* ((coll (mapcar #'(lambda (x)
3508                           (cond
3509                            ((symbolp x) (list (symbol-name x)))
3510                            ((stringp x) (list x))
3511                            (t x)))
3512                       coll))
3513         (completion1 (try-completion str coll pred))
3514         (completion2 (and strs (try-completion str strs pred)))
3515         (completion (if (and completion2
3516                              (or (not completion1)
3517                                  (< (length completion2)
3518                                     (length completion1))))
3519                         completion2
3520                       completion1)))
3521    (cond
3522     ((eq completion t))
3523     ((not completion)
3524      (message "Can't find completion for \"%s\"" str)
3525      (ding))
3526     ((not (string= str completion))
3527      (unless (equal completion completion1)
3528        (save-excursion
3529          (backward-char (length str))
3530          (insert "\"")))
3531      (insert (substring completion (length str)))
3532      (unless (equal completion completion1)
3533        (insert "\"")
3534        (backward-char)))
3535     (t
3536      (let ((win-config (current-window-configuration))
3537            (done nil))
3538        (message "Hit space to flush")
3539        (with-output-to-temp-buffer "*Completions*"
3540          (display-completion-list
3541           (sort
3542            (all-completions str (append strs coll) pred)
3543            'string-lessp)))
3544        (while (not done)
3545          (let ((event
3546                 (with-current-buffer (get-buffer "*Completions*")
3547                   (read-event))))
3548            (cond
3549             ((or (event-matches-key-specifier-p event 'tab)
3550                  (event-matches-key-specifier-p event 9))
3551              (save-selected-window
3552                (select-window (get-buffer-window "*Completions*"))
3553                (if (pos-visible-in-window-p (point-max))
3554                    (goto-char (point-min))
3555                  (scroll-up))))
3556             (t
3557              (set-window-configuration win-config)
3558              (if (or (event-matches-key-specifier-p event 'space)
3559                      (event-matches-key-specifier-p event 32))
3560                  (bury-buffer (get-buffer "*Completions*"))
3561                (setq unread-command-events (list event)))
3562              (setq done t))))))
3563      ))))
3564
3565(defun scheme-env-lookup (env sym)
3566  (let ((spec nil)
3567        (ls env))
3568    (while (and ls (not spec))
3569      (setq spec (assq sym (pop ls))))
3570    spec))
3571
3572(defun scheme-current-env ()
3573  ;; r5rs
3574  (let ((env (list *scheme-r5rs-info*)))
3575    ;; base language
3576    (let ((base (cdr (assq (current-scheme-implementation)
3577                           *scheme-implementation-exports*))))
3578      (if base (push base env)))
3579    ;; imports
3580    (let ((imports (current-scheme-imports)))
3581      (if imports (push imports env)))
3582    ;; top-level defs
3583    (let ((top (current-scheme-globals)))
3584      (if top (push top env)))
3585    ;; current local vars
3586    (let ((locals (current-local-vars env)))
3587      (if locals (push locals env)))
3588    env))
3589
3590(defun scheme-env-filter (pred env)
3591  (mapcar #'car
3592          (apply #'concatenate
3593                 'list
3594                 (mapcar #'(lambda (e) (remove-if-not pred e))
3595                         env))))
3596
3597;; checking return values:
3598;;   a should be capable of returning instances of b
3599(defun scheme-type-match-p (a b)
3600  (let ((a1 (scheme-translate-type a))
3601        (b1 (scheme-translate-type b)))
3602    (and (not (eq a1 'undefined))   ; check a *does* return something
3603         (or (eq a1 b1)             ; and they're the same
3604             (eq a1 'object)        ; ... or a can return anything
3605             (eq b1 'object)        ; ... or b can receive anything
3606             (if (symbolp a1)
3607                 (if (symbolp b1)
3608                     (case a1           ; ... or the types overlap
3609                       ((number complex real rational integer)
3610                        (memq b1 '(number complex real rational integer)))
3611                       ((port input-port output-port)
3612                        (memq b1 '(port input-port output-port)))
3613                       ((pair list)
3614                        (memq b1 '(pair list)))
3615                       ((non-procedure)
3616                        (not (eq 'procedure b1))))
3617                   (and
3618                    (consp b1)
3619                    (if (eq 'or (car b1))
3620                        ;; type unions
3621                        (find-if
3622                         #'(lambda (x)
3623                             (scheme-type-match-p
3624                              a1 (scheme-translate-type x)))
3625                         (cdr b1))
3626                      (let ((b2 (scheme-translate-special-type b1)))
3627                        (and (not (equal b1 b2))
3628                             (scheme-type-match-p a1 b2))))))
3629               (and (consp a1)
3630                    ;; type unions
3631                    (if (eq 'or (car a1))
3632                        (find-if
3633                         #'(lambda (x)
3634                             (scheme-type-match-p (scheme-translate-type x) b1))
3635                         (cdr a1))
3636                      ;; other special types
3637                      (let ((a2 (scheme-translate-special-type a1))
3638                            (b2 (scheme-translate-special-type b1)))
3639                        (and (or (not (equal a1 a2)) (not (equal b1 b2)))
3640                             (scheme-type-match-p a2 b2))))
3641                    ))))))
3642
3643(defun scheme-translate-special-type (x)
3644  (if (not (consp x))
3645      x
3646    (case (car x)
3647      ((list string) (car x))
3648      ((set special) (cadr x))
3649      ((flags) 'integer)
3650      (t x))))
3651
3652(defun nth* (n ls)
3653  (while (and (consp ls) (> n 0))
3654    (setq n (- n 1)
3655          ls (cdr ls)))
3656  (and (consp ls) (car ls)))
3657
3658(defun file->lines (file)
3659  (and (file-readable-p file)
3660       (with-find-file file
3661         (goto-char (point-min))
3662         (let ((res '()))
3663           (while (not (eobp))
3664             (let ((start (point)))
3665               (forward-line)
3666               (push (buffer-substring-no-properties start (- (point) 1))
3667                     res)))
3668           (reverse res)))))
3669
3670(defun passwd-file-names (file &optional pat)
3671  (delete
3672   nil
3673   (mapcar
3674    #'(lambda (line)
3675        (and (not (string-match "^[     ]*#" line))
3676             (or (not pat) (string-match pat line))
3677             (string-match "^\\([^:]*\\):" line)
3678             (match-string 1 line)))
3679    (file->lines file))))
3680
3681(defun host-file-names (file)
3682  (append-map
3683   #'(lambda (line)
3684       (let ((i (string-match "#" line)))
3685         (if i (setq line (substring line 0 i))))
3686       (cdr (split-string line)))
3687   (file->lines file)))
3688
3689(defun ssh-known-hosts-file-names (file)
3690  (append-map
3691   #'(lambda (line)
3692       (split-string (car (split-string line)) ","))
3693   (file->lines file)))
3694
3695(defun ssh-config-file-names (file)
3696  (append-map
3697   #'(lambda (line)
3698       (and (string-match "^ *Host" line)
3699            (cdr (split-string line))))
3700   (file->lines file)))
3701
3702(defun complete-user-name (sym)
3703  (if (string-match "apple" (emacs-version))
3704      (append (passwd-file-names "/etc/passwd" "^[^_].*")
3705              (delete "Shared" (directory-files "/Users" nil "^[^.].*")))
3706    (passwd-file-names "/etc/passwd")))
3707
3708(defun complete-host-name (sym)
3709  (append (host-file-names "/etc/hosts")
3710          (ssh-known-hosts-file-names "~/.ssh/known_hosts")
3711          (ssh-config-file-names "~/.ssh/config")))
3712
3713;; my /etc/services is 14k lines, so we try to optimize this
3714(defun complete-port-name (sym)
3715  (and (file-readable-p "/etc/services")
3716       (with-find-file "/etc/services"
3717         (goto-char (point-min))
3718         (let ((rx (concat "^\\(" (regexp-quote (if (symbolp sym)
3719                                                    (symbol-name sym)
3720                                                  sym))
3721                           "[^  ]*\\)"))
3722               (res '()))
3723           (while (not (eobp))
3724             (if (not (re-search-forward rx nil t))
3725                 (goto-char (point-max))
3726               (let ((str (match-string-no-properties 1)))
3727                 (if (not (equal str (car res)))
3728                     (push str res)))
3729               (forward-char 1)))
3730           res))))
3731
3732(defun complete-file-name (sym)
3733  (let ((file (file-name-nondirectory sym))
3734        (dir (or (file-name-directory sym) ".")))
3735    (file-name-all-completions file dir)))
3736
3737(defun complete-directory-name (sym)
3738  (let ((file (file-name-nondirectory sym))
3739        (dir (or (file-name-directory sym) ".")))
3740    (remove-if-not
3741     #'(lambda (x) (file-directory-p (concat dir "/" x)))
3742     (file-name-all-completions file dir))))
3743
3744(defun scheme-string-completer (type)
3745  (case type
3746    ((filename)
3747     '(complete-file-name file-name-nondirectory))
3748    ((directory)
3749     '(complete-directory-name file-name-nondirectory))
3750    (t
3751     (cond
3752      ((and (consp type) (eq 'string (car type)))
3753       (cadr type))
3754      ((and (consp type) (eq 'or (car type)))
3755       (car (delete nil (mapcar #'scheme-string-completer (cdr type)))))))))
3756
3757;; (defun remove-duplicate-strings/tail (ls)
3758;;   (while (consp ls)
3759;;     (delete (car ls) (cdr ls))
3760;;     (setq ls (cdr ls))))
3761
3762;; (defun remove-duplicate-strings (ls)
3763;;   (remove-duplicate-strings/tail ls)
3764;;   ls)
3765
3766(defun scheme-apply-string-completer (cmpl sym)
3767  (let ((func (if (consp cmpl) (car cmpl) cmpl))
3768        (trans (and (consp cmpl) (cadr cmpl))))
3769    (funcall func (if trans (funcall trans sym) sym))))
3770
3771(defun scheme-smart-complete (&optional arg)
3772  (interactive "P")
3773  (let* ((end (point))
3774         (start (save-excursion (skip-syntax-backward "w_") (point)))
3775         (sym (buffer-substring-no-properties start end))
3776         (in-str-p (scheme-in-string-p))
3777         (x (save-excursion
3778              (if in-str-p (beginning-of-string))
3779              (enclosing-2-sexp-prefixes)))
3780         (inner-proc (car x))
3781         (inner-pos (cadr x))
3782         (outer-proc (caddr x))
3783         (outer-pos (cadddr x))
3784         (env (save-excursion
3785                (if in-str-p (beginning-of-string))
3786                (scheme-current-env)))
3787         (outer-spec (scheme-env-lookup env outer-proc))
3788         (outer-type (scheme-translate-type (cadr outer-spec)))
3789         (inner-spec (scheme-env-lookup env inner-proc))
3790         (inner-type (scheme-translate-type (cadr inner-spec))))
3791    (cond
3792     ;; return all env symbols when a prefix arg is given
3793     (arg
3794      (do-completion sym (scheme-env-filter #'(lambda (x) t) env)))
3795     ;; for now just do file-name completion in strings
3796     (in-str-p
3797      (let* ((param-type
3798              (and (consp inner-type)
3799                   (eq 'lambda (car inner-type))
3800                   (scheme-lookup-type (cadr inner-type) inner-pos)))
3801             (completer (or (scheme-string-completer param-type)
3802                            '(complete-file-name file-name-nondirectory))))
3803        (do-completion
3804         (if (consp completer) (funcall (cadr completer) sym) sym)
3805         (scheme-apply-string-completer completer sym))))
3806     ;; outer special
3807     ((and (consp outer-type)
3808           (eq 'special (car outer-type))
3809           (cadddr outer-type))
3810      (do-completion sym (funcall (cadddr outer-type) sym)))
3811     ;; inner special
3812     ((and (consp inner-type)
3813           (eq 'special (car inner-type))
3814           (caddr inner-type))
3815      (do-completion sym (funcall (caddr inner-type) sym)))
3816     ;; completing inner procedure, complete procedures with a
3817     ;; matching return type
3818     ((and (consp outer-type)
3819           (eq 'lambda (car outer-type))
3820           (not (zerop outer-pos))
3821           (nth* outer-pos (cadr outer-type))
3822           (or (zerop inner-pos)
3823               (and (>= 1 inner-pos)
3824                    (consp inner-type)
3825                    (eq 'lambda (car inner-type))
3826                    (let ((param-type
3827                           (scheme-lookup-type (cadr inner-type) inner-pos)))
3828                      (and (consp param-type)
3829                           (eq 'lambda (car param-type))
3830                           (eq (caddr inner-type) (caddr param-type)))))))
3831      (let ((want-type (scheme-lookup-type (cadr outer-type) outer-pos)))
3832        (do-completion
3833         sym
3834         (scheme-env-filter
3835          #'(lambda (x)
3836              (let ((type (cadr x)))
3837                (or (memq type '(procedure object))
3838                    (and (consp type)
3839                         (or (and (eq 'syntax (car type))
3840                                  (not (eq 'undefined (caddr type))))
3841                             (and (eq 'lambda (car type))
3842                                  (scheme-type-match-p (caddr type)
3843                                                       want-type)))))))
3844          env))))
3845     ;; completing a normal parameter
3846     ((and inner-proc
3847           (not (zerop inner-pos))
3848           (consp inner-type)
3849           (eq 'lambda (car inner-type)))
3850      (let* ((param-type (scheme-lookup-type (cadr inner-type) inner-pos))
3851             (set-or-flags
3852              (or (and (consp param-type)
3853                       (case (car param-type)
3854                         ((set) (cddr param-type))
3855                         ((flags) (cdr param-type))))
3856                  ;; handle nested arithmetic functions inside a flags
3857                  ;; parameter
3858                  (and (not (zerop outer-pos))
3859                       (consp outer-type)
3860                       (eq 'lambda (car outer-type))
3861                       (let ((outer-param-type
3862                              (scheme-lookup-type (cadr outer-type)
3863                                                  outer-pos)))
3864                         (and (consp outer-param-type)
3865                              (eq 'flags (car outer-param-type))
3866                              (memq (scheme-translate-type param-type)
3867                                    '(number complex real rational integer))
3868                              (memq (scheme-translate-type (caddr inner-type))
3869                                    '(number complex real rational integer))
3870                              (cdr outer-param-type))))))
3871             (base-type (if set-or-flags
3872                            (if (and (consp param-type)
3873                                     (eq 'set (car param-type)))
3874                                (scheme-translate-type (cadr param-type))
3875                              'integer)
3876                            param-type))
3877             (base-completions
3878              (scheme-env-filter
3879               #'(lambda (x)
3880                   (scheme-type-match-p (cadr x) base-type))
3881               env))
3882             (str-completions
3883              (let ((completer (scheme-string-completer base-type)))
3884                (and
3885                 completer
3886                 (scheme-apply-string-completer completer sym)))))
3887        (do-completion
3888         sym
3889         (append set-or-flags base-completions)
3890         str-completions)))
3891     ;; completing a function
3892     ((zerop inner-pos)
3893      (do-completion
3894       sym
3895       (scheme-env-filter
3896        #'(lambda (x)
3897            (or (memq x '(procedure object))
3898                (and (consp (cadr x))
3899                     (memq (caadr x) '(lambda syntax)))))
3900        env)))
3901     ;; complete everything
3902     (t
3903      (do-completion sym (scheme-env-filter #'(lambda (x) t) env)) ))))
3904
3905(defun scheme-complete-or-indent (&optional arg)
3906  (interactive "P")
3907  (let* ((end (point))
3908         (func
3909          (save-excursion
3910            (beginning-of-line)
3911            (if (re-search-forward "\\S-" end t)
3912                'scheme-smart-complete
3913              'lisp-indent-line))))
3914    (funcall func arg)))
3915
3916;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3917;; optional eldoc function
3918
3919(defun scheme-optional-in-brackets (ls)
3920  ;; stupid xemacs won't allow ... as a symbol
3921  (setq ls (mapcar #'(lambda (x) (if (eq x '|...|) "..." x)) ls))
3922  ;; put optional arguments inside brackets (via a vector)
3923  (if (memq :optional ls)
3924      (let ((res '()))
3925        (while (and (consp ls) (not (eq :optional (car ls))))
3926          (push (pop ls) res))
3927        (reverse (cons (apply #'vector (cdr ls)) res)))
3928    ls))
3929
3930(defun scheme-base-type (x)
3931  (if (not (consp x))
3932      x
3933    (case (car x)
3934      ((string list) (car x))
3935      ((set) (or (cadr x) (car x)))
3936      ((flags) 'integer)
3937      ((lambda) 'procedure)
3938      ((syntax) 'syntax)
3939      (t x))))
3940
3941(defun sexp-to-string (sexp)
3942  (with-output-to-string (princ sexp)))
3943
3944(defun scheme-get-current-symbol-info ()
3945  (let* ((sym (eldoc-current-symbol))
3946         (fnsym0 (eldoc-fnsym-in-current-sexp))
3947         (fnsym (if (consp fnsym0) (car fnsym0) fnsym0))
3948         (env (save-excursion
3949                (if (scheme-in-string-p) (beginning-of-string))
3950                (scheme-current-env)))
3951         (spec (or (and sym (scheme-env-lookup env sym))
3952                   (and fnsym (scheme-env-lookup env fnsym)))))
3953    (and (consp spec)
3954         (consp (cdr spec))
3955         (let ((type (cadr spec)))
3956           (concat
3957            (cond
3958             ((nth 3 spec)
3959              "")
3960             ((and (consp type)
3961                   (memq (car type) '(syntax lambda)))
3962              (concat
3963               (if (eq (car type) 'syntax)
3964                   "syntax: "
3965                 "")
3966               (sexp-to-string
3967                (cons (car spec)
3968                      (scheme-optional-in-brackets
3969                       (mapcar #'scheme-base-type (cadr type)))))
3970               (if (and (consp (cddr type))
3971                        (not (memq (caddr type) '(obj object))))
3972