emacs/scheme-complete.el

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