v08i050: Elk (Extension Language Toolkit) part 02 of 14
Brandon S. Allbery - comp.sources.misc
allbery at uunet.UU.NET
Sun Sep 24 07:39:14 AEST 1989
Posting-number: Volume 8, Issue 50
Submitted-by: net at tub.UUCP (Oliver Laumann)
Archive-name: elk/part02
[Let this be a lesson to submitters: this was submitted as uuencoded,
compressed files. I lost the source information while unpacking it; this
is the best approximation I could come up with. ++bsa]
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of archive 2 (of 14)."
# Contents: doc/func.ms src/object.h src/main.c src/Makefile
# src/config.h src/features.c
# Wrapped by net at tub on Sun Sep 17 17:32:17 1989
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f doc/func.ms -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"doc/func.ms\"
else
echo shar: Extracting \"doc/func.ms\" \(36444 characters\)
sed "s/^X//" >doc/func.ms <<'END_OF_doc/func.ms'
X.so tmac.scheme
X.RP
X.ds R "R\v'-.3m'\s-13\s0\v'.3m'RS
X.ds 1 "\v'.3m'\s-11\s0\v'-.3m'
X.ds 2 "\v'.3m'\s-12\s0\v'-.3m'
X.TL
XFunctionality of the
X.br
XElk Extension Language Interpreter
X.sp
XOverview
X.AU
XOliver Laumann
X.AB
XThis memo provides a complete list of all primitive procedures
Ximplemented by the Elk Extension Language.
XOnly those procedures that are not defined in the
X\f2Revised\v'-.3m'\s-13\s0\v'.3m' Report on the Algorithmic
XLanguage Scheme\fP by Jonathan Rees and William Clinger (editors)
Xare described in the memo.
XThe procedures that are mentioned in the report are only listed \-
Xno description is provided.
XExamples are given for many procedures.
X.AE
X.C Lambda Expressions, Procedures
X.SH
X.tl '(lambda \f2formals\fP \f2body\fP)''syntax'
X.LP
XSee \*R.
X.SH
X.tl '(procedure-lambda \f2procedure\fP)''procedure'
X.LP
XReturns a copy of the \f2lambda\fP expression which has been
Xevaluated to create the given procedure.
X.br
XExample:
X.ss
X(define (square x) (* x x))
X(procedure-lambda square) ==> (lambda (x) (* x x))
X.se
X.SH
X.tl '(procedure? \f2obj\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(primitive? \f2obj\fP)''procedure'
X.LP
XReturns #t if \f2obj\fP is a primitive procedure, #f otherwise.
X.SH
X.tl '(compound? \f2obj\fP)''procedure'
X.LP
XReturns #t if \f2obj\fP is a compound procedure (a procedure that
Xhas been created by evaluating a lambda expression), #f otherwise.
X.C Local Bindings
X.SH
X.tl '(let \f2bindings\fP \f2body\fP)''syntax'
X.tl '(let* \f2bindings\fP \f2body\fP)''syntax'
X.tl '(letrec \f2bindings\fP \f2body\fP)''syntax'
X.LP
XSee \*R.
X.C Fluid Binding
X.SH
X.tl '(fluid-let \f2bindings\fP \f2body\fP)''syntax'
X.LP
X\f2bindings\fP is of the form ((\f2variable\*1\fP \f2init1\fP) ...).
XThe \f2init\fPs are temporarily assigned to the \f2variable\fPs
Xand the \f2body\fP is executed.
XThe variables must be bound in an enclosing scope.
XWhen the body is exited normally or by invoking a control point,
Xthe old values of the variables are restored.
XIn the latter case, when the control returns back to the body
Xof the fluid-let by invocation of a control point created within
Xthe body, the bindings are changed again to the values they had
Xwhen the body exited.
X.br
XExamples:
X.ss
X((lambda (x)
X (+ x (fluid-let ((x 3)) x))) 1) ==> 4
X.se
X.ss
X(fluid-let ((print-length 2))
X (write '(a b c d))) ==> '(a b ...)
X.se
X.ss
X(define (errset thunk)
X (call-with-current-continuation
X (lambda (catch)
X (fluid-let
X ((error-handler
X (lambda msg (catch #f))))
X (list (thunk))))))
X.sp
X(errset (lambda () (+ 1 2))) ==> (3)
X(errset (lambda () (/ 1 0))) ==> #f
X.se
X.C Definitions
X.SH
X.tl '(define \f2variable\fP \f2expression\fP)''syntax'
X.tl '(define (\f2variable\fP \f2formals\fP) \f2body\fP)''syntax'
X.tl '(define (\f2variable\fP . \f2formal\fP) \f2body\fP)''syntax'
X.LP
XSee \*R.
X.br
XReturns a symbol, the identifier that has been bound.
XDefinitions may appear anywhere within a local body (e.\|g. a lambda
Xbody or a \f2let\fP).
XIf the \f2expression\fP is omitted, \f2void\fP (the non-printing
Xobject) is used.
X.br
XExamples:
X.ss
X(define nil #f)
X.se
X.ss
X(define ((f x) y) (cons x y))
X(define (g x) ((f x) 5))
X(g 'a) ==> (a . 5)
X.se
X.C Assignment
X.SH
X.tl '(set! \f2variable\fP \f2expression\fP)''syntax'
X.LP
XSee \*R.
X.br
XReturns the previous value of \f2variable\fP.
X.br
XExamples:
X.ss
X(define-macro (swap x y)
X `(set! ,x (set! ,y ,x)))
X.se
X.C Procedure Application
X.SH
X.tl '(\f2operator\fP \f2operand\*1\fP ...)''syntax'
X.LP
XSee \*R.
X\f2operator\fP can be a macro (see below).
X.SH
X.tl '(apply \f2arg\*1\fP ... \f2args\fP)''procedure'
X.LP
XSee \*R.
X.C Quotation, Quasiquotation
X.SH
X.tl '(quote \f2datum\fP)''syntax'
X.tl ,'\f2datum\fP,,syntax,
X.tl '\f2constant\fP''syntax'
X.LP
XSee \*R.
X.br
XVectors need not be quoted; a vector evaluates to itself.
X.SH
X.tl '(quasiquote \f2expression\fP)''syntax'
X.tl '(unquote \f2expression\fP)''syntax'
X.tl '(unquote-splicing \f2expression\fP)''syntax'
X.LP
XSee \*R.
X.C Sequencing
X.SH
X.tl '(begin \f2expression\*1\fP \f2expression\*2\fP ...)''syntax'
X.LP
XSee \*R.
X.SH
X.tl '(begin1 \f2expression\*1\fP \f2expression\*2\fP ...)''syntax'
X.LP
XIdentical to \f2begin\fP, except that the result of the first
X\f2expression\fP is returned.
X.C Conditionals
X.SH
X.tl '(if \f2test\fP \f2consequent\fP \f2alternate\fP)''syntax'
X.tl '(if \f2test\fP \f2consequent\fP)''syntax'
X.LP
XSee \*R.
X.br
XIn the first form, \f2alternate\fP can be a sequence of expressions
X(implicit \f2begin\fP).
X.SH
X.tl '(case \f2key\fP \f2clause\*1\fP \f2clause\*2\fP ...)''syntax'
X.LP
XSee \*R.
X.br
XEach \f2clause\fP not beginning with \f2else\fP can be of the form
X.DS
X((\f2datum\*1\fP ...) \f2expression\*1\fP \f2expression\*2\fP ...)
X.DE
Xor
X.DS
X(\f2datum\fP \f2expression\*1\fP \f2expression\*2\fP ...)
X.DE
XIn the latter case, the \f2key\fP is matched against the \f2datum\fP.
X.SH
X.tl '(cond \f2clause\*1\fP \f2clause\*2\fP ...)''syntax'
X.LP
XSee \*R.
X.SH
X.tl '(and \f2test\*1\fP ...)''syntax'
X.tl '(or \f2test\*1\fP ...)''syntax'
X.LP
XSee \*R.
X.C Booleans
X.SH
X.tl '(not \f2obj\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(boolean? \f2obj\fP)''procedure'
X.LP
XSee \*R.
X.C Iteration
X.SH
X.tl '(let \f2variable\fP \f2bindings\fP \f2body\fP)''syntax'
X.LP
X``Named \f2let\fP''. See \*R.
X.SH
X.tl '(map \f2procedure\fP \f2list\*1\fP \f2list\*2\fP ...)''procedure'
X.tl '(for-each \f2procedure\fP \f2list\*1\fP \f2list\*2\fP ...)''procedure'
X.LP
XSee \*R. \f2for-each\fP returns the empty list.
X.SH
X.tl '(do \f2initializations\fP \f2test\fP \f2body\fP)''syntax'
X.LP
XSee \*R.
X.C Continuations
X.SH
X.tl '(call-with-current-continuation \f2procedure\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(control-point? \f2obj\fP)''procedure'
X.LP
XReturns #t if \f2obj\fP is a control point (a continuation),
X#f otherwise.
X.SH
X.tl '(dynamic-wind \f2thunk\fP \f2thunk\fP \f2thunk\fP)''procedure'
X.LP
X\f2dynamic-wind\fP is a generalization of the \f2unwind-protect\fP
Xfacility provided by many Lisp systems.
X.br
XAll three arguments are procedures of no arguments.
XIn the normal case, all three thunks are applied in order.
XThe first thunk is also applied when the body (the second thunk)
Xis entered by the application of a control point created within
Xthe body (by means of \f2call-with-current-continuation\fP).
XSimilarly, the third thunk is also applied whenever the body is
Xexited by invocation of a control point created outside the body.
X.br
XExamples:
X.ss
X(define-macro (unwind-protect body . unwind-forms)
X `(dynamic-wind
X (lambda () #f)
X (lambda () ,body)
X (lambda () , at unwind-forms)))
X.se
X.ss
X(let ((f (open-input-file "foo")))
X (dynamic-wind
X (lambda () #f)
X (lambda () \f2do something with\fP f)
X (lambda () (close-port f))))
X.se
X.C Delayed Evaluation
X.SH
X.tl '(delay \f2expression\fP)''syntax'
X.tl '(force \f2promise\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(promise? \f2obj\fP)''procedure'
X.LP
XReturns #t if \f2obj\fP is a promise, an object returned by the
Xapplication of \f2delay\fP.
XOtherwise #f is returned.
X.C Equivalence Predicates
X.SH
X.tl '(eq? \f2obj\*1\fP \f2obj\*2\fP)''procedure'
X.tl '(eqv? \f2obj\*1\fP \f2obj\*2\fP)''procedure'
X.tl '(equal? \f2obj\*1\fP \f2obj\*2\fP)''procedure'
X.LP
XSee \*R.
X.C Pairs and Lists
X.SH
X.tl '(cons \f2obj\*1\fP \f2obj\*2\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(car \f2pair\fP)''procedure'
X.tl '(cdr \f2pair\fP)''procedure'
X.LP
XSee \*R.
X.br
X\f2car\fP or \f2cdr\fP applied to the empty list returns the empty list.
X.SH
X.tl '(cxr \f2pair\fP \f2pattern\fP)''procedure'
X.LP
X\f2pattern\fP is either a symbol or a string consisting of a combination
Xof the characters `a' and `d'.
XIt encodes a sequence of \f2car\fP and \f2cdr\fP operations;
Xeach `a' denotes the application of \f2car\fP, and each `d' denotes
Xthe application of \f2cdr\fP.
XFor example, \f2(cxr p "ada")\fP is equivalent to \f2(cadar p)\fP.
X.SH
X.tl '(caar \f2pair\fP)''procedure'
X.br
X ...
X.br
X.tl '(cdddr \f2pair\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(set-car! \f2pair\fP \f2obj\fP)''procedure'
X.tl '(set-cdr! \f2pair\fP \f2obj\fP)''procedure'
X.LP
XSee \*R.
X.br
XBoth procedures return \f2obj\fP.
X.SH
X.tl '(make-list \f2k\fP \f2obj\fP)''procedure'
X.LP
XReturns a list of length \f2k\fP initialized with \f2obj\fP.
X.br
XExamples:
X.ss
X(make-list 0 'a) ==> ()
X(make-list 2 (make-list 2 1)) ==> ((1 1) (1 1))
X.se
X.SH
X.tl '(list \f2obj\fP ...)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(length \f2list\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(list-ref \f2list\fP \f2k\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(list-tail \f2list\fP \f2k\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(last-pair \f2list\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(append \f2list\fP ...)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(append! \f2list\fP ...)''procedure'
X.LP
XLike \f2append\fP, except that the original
Xarguments are modified (destructive \f2append\fP).
XThe cdr of each argument is changed to point to the next argument.
X.br
XExamples:
X.ss
X(define x '(a b))
X(append x '(c d)) ==> (a b c d)
Xx ==> (a b)
X(append! x '(c d)) ==> (a b c d)
Xx ==> (a b c d)
X.se
X.SH
X.tl '(reverse \f2list\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(reverse! \f2list\fP)''procedure'
X.LP
XDestructive \f2reverse\fP.
X.SH
X.tl '(memq \f2obj\fP \f2list\fP)''procedure'
X.tl '(memv \f2obj\fP \f2list\fP)''procedure'
X.tl '(member \f2obj\fP \f2list\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(assq \f2obj\fP \f2alist\fP)''procedure'
X.tl '(assv \f2obj\fP \f2alist\fP)''procedure'
X.tl '(assoc \f2obj\fP \f2alist\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(null? \f2obj\fP)''procedure'
X.tl '(pair? \f2obj\fP)''procedure'
X.LP
XSee \*R.
X.C Numbers
X.SH
X.tl '(= \f2z\*1\fP \f2z\*2\fP ...)''procedure'
X.tl '(< \f2z\*1\fP \f2z\*2\fP ...)''procedure'
X.tl '(> \f2z\*1\fP \f2z\*2\fP ...)''procedure'
X.tl '(<= \f2z\*1\fP \f2z\*2\fP ...)''procedure'
X.tl '(>= \f2z\*1\fP \f2z\*2\fP ...)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(1+ \f2z\fP)''procedure'
X.tl '(1- \f2z\fP)''procedure'
X.LP
XReturns \f2z\fP plus 1 or \f2z\fP minus 1, respectively.
X.SH
X.tl '(+ \f2z\*1\fP ...)''procedure'
X.tl '(* \f2z\*1\fP ...)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(- \f2z\*1\fP \f2z\*2\fP ...)''procedure'
X.tl '(/ \f2z\*1\fP \f2z\*2\fP ...)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(zero? \f2z\fP)''procedure'
X.tl '(positive? \f2z\fP)''procedure'
X.tl '(negative? \f2z\fP)''procedure'
X.tl '(odd? \f2z\fP)''procedure'
X.tl '(even? \f2z\fP)''procedure'
X.tl '(exact? \f2z\fP)''procedure'
X.tl '(inexact? \f2z\fP)''procedure'
X.LP
XSee \*R.
X.br
X\f2exact?\fP returns always #f; \f2inexact?\fP returns always #t.
X.SH
X.tl '(abs \f2z\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(quotient \f2n\*1\fP \f2n\*2\fP)''procedure'
X.tl '(remainder \f2n\*1\fP \f2n\*2\fP)''procedure'
X.tl '(modulo \f2n\*1\fP \f2n\*2\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(gcd \f2n\*1\fP ...)''procedure'
X.tl '(lcm \f2n\*1\fP ...)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(floor \f2x\fP)''procedure'
X.tl '(ceiling \f2x\fP)''procedure'
X.tl '(truncate \f2x\fP)''procedure'
X.tl '(round \f2x\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(sqrt \f2z\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(exp \f2z\fP)''procedure'
X.tl '(log \f2z\fP)''procedure'
X.tl '(sin \f2z\fP)''procedure'
X.tl '(cos \f2z\fP)''procedure'
X.tl '(tan \f2z\fP)''procedure'
X.tl '(asin \f2z\fP)''procedure'
X.tl '(acos \f2z\fP)''procedure'
X.tl '(atan \f2z\fP)''procedure'
X.tl '(atan \f2y\fP \f2x\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(min \f2x\*1\fP \f2x\*2\fP ...)''procedure'
X.tl '(max \f2x\*1\fP \f2x\*2\fP ...)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(random)''procedure'
X.LP
XReturns an integer pseudo-random number in the range from 0 to
X2\v'-.3m'\s-131\s0\v'.3m'-1.
X.SH
X.tl '(srandom \f2n\fP)''procedure'
X.LP
XSets the random number generator to the starting point \f2n\fP.
X\f2srandom\fP returns \f2n\fP.
X.SH
X.tl '(number? \f2obj\fP)''procedure'
X.tl '(complex? \f2obj\fP)''procedure'
X.tl '(real? \f2obj\fP)''procedure'
X.tl '(rational? \f2obj\fP)''procedure'
X.tl '(integer? \f2obj\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(string\(mi>number \f2string\fP)''procedure'
X.LP
XSee \*R (\f2exactness\fP and \f2radix\fP are currently not supported).
X.C Characters
X.SH
X.tl '(char\(mi>integer \f2char\fP)''procedure'
X.tl '(integer\(mi>char \f2n\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(char-upper-case? \f2char\fP)''procedure'
X.tl '(char-lower-case? \f2char\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(char-alphabetic? \f2char\fP)''procedure'
X.tl '(char-numeric? \f2char\fP)''procedure'
X.tl '(char-whitespace? \f2char\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(char-upcase \f2char\fP)''procedure'
X.tl '(char-downcase \f2char\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(char=? \f2char\*1\fP \f2char\*2\fP)''procedure'
X.tl '(char<? \f2char\*1\fP \f2char\*2\fP)''procedure'
X.tl '(char>? \f2char\*1\fP \f2char\*2\fP)''procedure'
X.tl '(char<=? \f2char\*1\fP \f2char\*2\fP)''procedure'
X.tl '(char>=? \f2char\*1\fP \f2char\*2\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(char-ci=? \f2char\*1\fP \f2char\*2\fP)''procedure'
X.tl '(char-ci<? \f2char\*1\fP \f2char\*2\fP)''procedure'
X.tl '(char-ci>? \f2char\*1\fP \f2char\*2\fP)''procedure'
X.tl '(char-ci<=? \f2char\*1\fP \f2char\*2\fP)''procedure'
X.tl '(char-ci>=? \f2char\*1\fP \f2char\*2\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(char? \f2obj\fP)''procedure'
X.LP
XSee \*R.
X.C Strings
X.SH
X.tl '(string \f2char\fP ...)''procedure'
X.LP
XReturns a string containing the specified characters.
X.br
XExamples:
X.ss
X(string) ==> ""
X(string #\ea #\espace #\eb) ==> "a b"
X.se
X.SH
X.tl '(string? \f2obj\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(make-string \f2k\fP \f2char\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(string-length \f2string\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(string-ref \f2string\fP \f2k\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(string-set! \f2string\fP \f2k\fP \f2char\fP)''procedure'
X.LP
XSee \*R.
X.br
XReturns the previous value of element \f2k\fP of the given string.
X.SH
X.tl '(substring \f2string\fP \f2start\fP \f2end\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(string-copy \f2string\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(string-append \f2string\fP ...)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(list\(mi>string \f2chars\fP)''procedure'
X.tl '(string\(mi>list \f2string\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(string-fill! \f2string\fP \f2char\fP)''procedure'
X.LP
XSee \*R.
X.br
XReturns \f2string\fP.
X.SH
X.tl '(substring-fill! \f2string\fP \f2start\fP \f2end\fP \f2char\fP)''procedure'
X.LP
XStores \f2char\fP in every element of \f2string\fP from \f2start\fP
X(inclusive) to \f2end\fP (exclusive).
XReturns \f2string\fP.
X.SH
X.tl '(string=? \f2string\*1\fP \f2string\*2\fP)''procedure'
X.tl '(string<? \f2string\*1\fP \f2string\*2\fP)''procedure'
X.tl '(string>? \f2string\*1\fP \f2string\*2\fP)''procedure'
X.tl '(string<=? \f2string\*1\fP \f2string\*2\fP)''procedure'
X.tl '(string>=? \f2string\*1\fP \f2string\*2\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(string-ci=? \f2string\*1\fP \f2string\*2\fP)''procedure'
X.tl '(string-ci<? \f2string\*1\fP \f2string\*2\fP)''procedure'
X.tl '(string-ci>? \f2string\*1\fP \f2string\*2\fP)''procedure'
X.tl '(string-ci<=? \f2string\*1\fP \f2string\*2\fP)''procedure'
X.tl '(string-ci>=? \f2string\*1\fP \f2string\*2\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(substring? \f2string\*1\fP \f2string\*2\fP)''procedure'
X.tl '(substring-ci? \f2string\*1\fP \f2string\*2\fP)''procedure'
X.LP
XIf \f2string\*1\fP is a substring of \f2string\*2\fP, these
Xprocedures return the starting position of the first occurrence of the
Xsubstring within \f2string\*2\fP.
XOtherwise #f is returned.
X\f2substring-ci?\fP is the case insensitive version of \f2substring?\fP.
X.br
XExamples:
X.ss
X(define s "Hello world")
X(substring? "foo" x) ==> #f
X(substring? "hello" x) ==> #f
X(substring-ci? "hello" x) ==> 0
X(substring? "!" x) ==> 11
X.se
X.C Vectors
X.SH
X.tl '(vector? \f2obj\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(make-vector \f2k\fP)''procedure'
X.tl '(make-vector \f2k\fP \f2fill\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(vector \f2obj\fP ...)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(vector-length \f2vector\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(vector-ref \f2vector\fP \f2k\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(vector-set! \f2vector\fP \f2k\fP \f2obj\fP)''procedure'
X.LP
XSee \*R.
X.br
XReturns the previous value of element \f2k\fP of the vector.
X.SH
X.tl '(vector\(mi>list \f2vector\fP)''procedure'
X.tl '(list\(mi>vector \f2list\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(vector-fill! \f2vector\fP \f2fill\fP)''procedure'
X.LP
XSee \*R.
X.br
XReturns \f2vector\fP.
X.SH
X.tl '(vector-copy \f2vector\fP)''procedure'
X.LP
XReturns a copy of \f2vector\fP.
X.C Symbols
X.SH
X.tl '(string\(mi>symbol \f2string\fP)''procedure'
X.tl '(symbol\(mi>string \f2symbol\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(put \f2symbol\fP \f2key\fP \f2value\fP)''procedure'
X.tl '(put \f2symbol\fP \f2key\fP)''procedure'
X.LP
XAssociates \f2value\fP with \f2key\fP in the property list of the
Xgiven symbol.
X\f2key\fP must be a symbol.
XReturns \f2key\fP.
X.br
XIf \f2value\fP is omitted, the property is removed from the symbol's
Xproperty list.
X.SH
X.tl '(get \f2symbol\fP \f2key\fP)''procedure'
X.LP
XReturns the value associated with \f2key\fP in the property
Xlist of \f2symbol\fP.
X\f2key\fP must be a symbol.
XIf no value is associated with \f2key\fP in the symbol's property
Xlist, #f is returned.
X.br
XExamples:
X.ss
X(put 'norway 'capital "Oslo")
X(put 'norway 'continent "Europe")
X(get 'norway 'capital) ==> "Oslo"
X.se
X.SH
X.tl '(symbol-plist \f2symbol\fP)''procedure'
X.LP
XReturns a copy of the property list of \f2symbol\fP as an \f2alist\fP.
X.br
XExamples:
X.ss
X(put 'norway 'capital "Oslo")
X(put 'norway 'continent "Europe")
X(symbol-plist 'norway)
X ==> ((capital . "Oslo") (continent . "Europe"))
X(symbol-plist 'foo) ==> ()
X.se
X.SH
X.tl '(symbol? \f2obj\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(oblist)''procedure'
X.LP
XReturns a list of lists containing all currently interned symbols.
XEach sublist represents a bucket of the interpreters internal
Xhash array.
X.br
XExamples:
X.ss
X(define (apropos what)
X (let ((ret ()))
X (do ((tail (oblist) (cdr tail))) ((null? tail))
X (do ((l (car tail) (cdr l))) ((null? l))
X (if (substring? what (symbol->string (car l)))
X (set! ret (cons (car l) ret)))))
X ret))
X.se
X.ss
X.ta 7c
X(apropos "let") ==> (let* let letrec fluid-let)
X(apropos "make") ==> (make-list make-vector make-string)
X(apropos "foo") ==> ()
X.se
X.C Environments
X.SH
X.tl '(the-environment)''procedure'
X.LP
XReturns the current environment.
X.SH
X.tl '(global-environment)''procedure'
X.LP
XReturns the global environment (the ``root'' environment in which
Xall predefined procedures are bound).
X.SH
X.tl '(environment\(mi>list \f2environment\fP)''procedure'
X.LP
XReturns a list representing the specified environment.
XThe list is a list of \f2frames\fP, each frame is a list of bindings
X(an \f2alist\fP).
XThe car of the list represents the most recently established environment.
XThe list returned by \f2environment\(mi>list\fP can contain cycles.
X.br
XExamples:
X.ss
X(let ((x 1) (y 2))
X (car (environment->list
X (the-environment)))) ==> ((y . 2) (x . 1))
X.se
X.ss
X((lambda (foo)
X (caar (environment->list
X (the-environment)))) "abc") ==> (foo . "abc")
X.se
X.ss
X(eq?
X (car (last-pair (environment->list
X (the-environment))))
X (car (environment->list
X (global-environment)))) ==> #t
X.se
X.SH
X.tl '(procedure-environment \f2procedure\fP)''procedure'
X.tl '(promise-environment \f2promise\fP)''procedure'
X.tl '(control-point-environment \f2control-point\fP)''procedure'
X.LP
XReturns the environment in which the the body of the \f2procedure\fP
Xis evaluated, the environment in which a value for the \f2promise\fP
Xis computed when \f2force\fP is applied to it, or the environment in
Xwhich the \f2control-point\fP has been created, respectively.
X.SH
X.tl '(environment? \f2obj\fP)''procedure'
X.LP
XReturns #t if \f2obj\fP is an environment, #f otherwise.
X.C Ports and Files
X.LP
XGenerally, a file name can either be a string or a symbol.
XIf a symbol is given, it is converted into a string by
Xapplying \f2symbol\(mi>string\fP.
XA tilde at the beginning of a file name is expanded according
Xto the rules employed by the C-Shell (see \f2csh\fP(1)).
X.SH
X.tl '(call-with-input-file \f2file\fP \f2procedure\fP)''procedure'
X.tl '(call-with-output-file \f2file\fP \f2procedure\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(input-port? \f2obj\fP)''procedure'
X.tl '(output-port? \f2obj\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(current-input-port)''procedure'
X.tl '(current-output-port)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(with-input-from-file \f2file\fP \f2thunk\fP)''procedure'
X.tl '(with-output-to-file \f2file\fP \f2thunk\fP)''procedure'
X.LP
XSee \*R.
X.br
X\f2file\fP can be a string as well as a symbol.
X.SH
X.tl '(open-input-file \f2file\fP)''procedure'
X.tl '(open-output-file \f2file\fP)''procedure'
X.LP
XSee \*R.
X.br
X\f2file\fP can be a string as well as a symbol.
X.SH
X.tl '(close-port \f2port\fP)''procedure'
X.LP
XSee \f2close-input-port\fP and \f2close-output-port\fP in \*R.
X.SH
X.tl '(clear-output-port)''procedure'
X.tl '(clear-output-port \f2output-port\fP)''procedure'
X.LP
XIf the argument is omitted, it defaults to the current output port.
X.br
XIn case of ``buffered'' output, this procedure is used to discard
Xall characters that have been
Xoutput to the port but have not yet been sent to the file associated
Xwith the port.
X.SH
X.tl '(flush-output-port)''procedure'
X.tl '(flush-output-port \f2output-port\fP)''procedure'
X.LP
XIf the argument is omitted, it defaults to the current output port.
X.br
XIn case of ``buffered'' output, this procedure is used to force
Xall characters that have been output to the port to be printed
Ximmediately.
XThis may be necessary to force output that is not terminated with a newline
Xto appear on the terminal.
XAn output port is flushed automatically when it is closed.
X.SH
X.tl '(clear-input-port)''procedure'
X.tl '(clear-input-port \f2input-port\fP)''procedure'
X.LP
XIf the argument is omitted, it defaults to the current input port.
X.br
XIn case of ``buffered'' input,
Xthis procedure discards all characters that have already been read
Xfrom the file associated with the port but have not been processed
Xusing \f2read\fP or similar procedures.
X.SH
X.tl '(port-file-name \f2port\fP)''procedure'
X.LP
XReturns the name of the file associated with \f2port\fP if it is
Xa file port, #f otherwise.
X.SH
X.tl '(tilde-expand \f2file\fP)''procedure'
X.LP
XIf \f2file\fP starts with a tilde, performs tilde expansion as
Xdescribed above and returns the result of the expansion
X(a string); returns \f2file\fP otherwise.
X\f2file\fP is a string or a symbol.
X.SH
X.tl '(file-exists? \f2file\fP)''procedure'
X.LP
XReturns #t if \f2file\fP exists, #f otherwise.
X\f2file\fP is a string or a symbol; tilde expansion is not performed.
X.C Input
X.SH
X.tl '(read)''procedure'
X.tl '(read \f2input-port\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(read-char)''procedure'
X.tl '(read-char \f2input-port\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(read-string)''procedure'
X.tl '(read-string \f2input-port\fP)''procedure'
X.LP
XIf the argument is omitted, it defaults to the current input port.
X.br
XReturns the rest of the current input line as a string (not
Xincluding the terminating newline).
X.SH
X.tl '(unread-char \f2char\fP)''procedure'
X.tl '(unread-char \f2char\fP \f2input-port\fP)''procedure'
X.LP
XIf the second argument is omitted, it defaults to the current input port.
X.br
XPushes \f2char\fP back on the stream of input characters.
XIt is \f2not\fP an error for \f2char\fP not to be the last character
Xread from the port.
XThe procedure returns \f2char\fP.
X.br
XExamples:
X.ss
X(define (peek-char port)
X (unread-char (read-char port) port))
X.se
X.SH
X.tl '(eof-object? \f2obj\fP)''procedure'
X.LP
XSee \*R.
X.C Output
X.LP
XPrinting is controlled by the variables \f2print-length\fP and
X\f2print-depth\fP; these variables are bound in the global environment.
X\f2print-length\fP determines the maximum length of a list or vector
Xthat is printed; \f2print-depth\fP determines the maximum depth.
XIf the value of one of the variables is not an integer, a default
Xvalue is taken.
X.SH
X.tl '(write \f2obj\fP)''procedure'
X.tl '(write \f2obj\fP \f2output-port\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(display \f2obj\fP)''procedure'
X.tl '(display \f2obj\fP \f2output-port\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(write-char \f2char\fP)''procedure'
X.tl '(write-char \f2char\fP \f2output-port\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(newline)''procedure'
X.tl '(newline \f2output-port\fP)''procedure'
X.LP
XSee \*R.
X.SH
X.tl '(print \f2obj\fP)''procedure'
X.tl '(print \f2obj\fP \f2output-port\fP)''procedure'
X.LP
XIf the second argument is omitted, it defaults to the current output port.
X.br
XPrints \f2obj\fP using \f2write\fP and then prints a newline.
X\f2print\fP returns \f2void\fP.
X.SH
X.tl '(format \f2destination\fP \f2format-string\fP \f2obj\fP ...)''procedure'
X.LP
XPrints the third and the following arguments according to the
Xspecifications in the string \f2format-string\fP.
XCharacters from the format string are copied to the output.
XWhen a tilde is encountered in the format string, the tilde and
Xthe immediately following character are replaced in the output
Xas follows:
X.IP "~s"
Xis replaced by the printed representation of the next \f2obj\fP
Xin the sense of \f2write\fP.
X.IP "~a"
Xis replaced by the printed representation of the next \f2obj\fP
Xin the sense of \f2display\fP.
X.IP "~~"
Xis replaced by a single tilde.
X.IP "~%"
Xis replaced by a newline.
X.LP
XAn error is signaled if fewer \f2obj\fPs are provided than
Xrequired by the given format string.
XIf the format string ends in a tilde, the tilde is ignored.
X.LP
XIf \f2destination\fP is #t, the output is sent to the current
Xoutput port; if #f is given, the output is returned as a string;
Xotherwise, \f2destination\fP must be an output port.
X.br
XExamples:
X.ss
X(format #f "Hello world!") ==> "Hello world"
X(format #f "~s world!" "Hello") ==> "\e"Hello\e" world"
X(format #f "~a world!" "Hello") ==> "Hello world"
X(format #f "Hello~a") ==> "Hello!"
X.se
X.ss
X(define (flat-size s)
X (fluid-let ((print-length 1000) (print-depth 100))
X (string-length (format #f "~a" s))))
X.se
X.ss
X(flat-size 1.5) ==> 3
X(flat-size '(a b c)) ==> 7
X.se
X.C String Ports
X.LP
XString ports are similar to file ports, except that characters are
Xappended to a string instead of being sent to a file, or taken
Xfrom a string instead of being read from a file.
XIt is not necessary to close string ports.
XWhen an string input port has reached the end of the input string,
Xsuccessive read operations return end-of-file.
X.SH
X.tl '(open-input-string \f2string\fP)''procedure'
X.LP
XReturns a new string input port initialized with \f2string\fP.
X.br
XExamples:
X.ss
X(define p (open-input-string "Hello world!"))
X(read-char p) ==> #\eH
X(read p) ==> ello
X(read p) ==> world!
X(read p) ==> \f2end of file\fP
X.se
X.ss
X(define p (open-input-string "(cons 'a 'b)"))
X(eval (read p)) ==> (a . b)
X.se
X.SH
X.tl '(open-output-string)''procedure'
X.LP
XReturns a new string output port.
X.SH
X.tl '(get-output-string \f2string-output-port\fP)''procedure'
X.LP
XReturns the string currently associated with the specified string
Xoutput port.
XAs a side-effect, the string is reset to zero length.
X.br
XExamples:
X.ss
X(define p (open-output-string))
X(display '(a b c) p)
X(get-output-string p) ==> "(a b c)"
X(get-output-string p) ==> ""
X.se
X.ss
X(define (flat-size s)
X (let ((p (open-output-string)))
X (display s p)
X (string-length (get-output-string p))))
X.se
X.C Loading
X.LP
XA file to be loaded is searched for in the a list of directories
Xdetermined by the variable \f2load-path\fP.
X\f2load-path\fP is a list of symbols or strings each of which
Xis used in turn as a prefix for the file name passed to \f2load\fP
Xuntil opening succeeds.
X\f2load-path\fP is bound in the global environment.
X.SH
X.tl '(load \f2file\fP)''procedure'
X.tl '(load \f2file\fP \f2environment\fP)''procedure'
X.LP
XLoads a source file or an object file.
XIf the file contains source code, the expressions in the file are
Xread and evaluated.
XIf the value of the variable \f2load-noisily?\fP is true,
Xthe result of the evaluation of each expression is printed
X(\f2load-noisily\fP is bound in the global environment; its value
Xis #f initially).
XIf the file contains object code, the contents of the file is linked
Xtogether with the running interpreter and with additional libraries
Xthat are specified by the global string variable \f2load-libraries\fP
X(for instance, ``-lc -lm'').
XObject files must end in the suffix ``.o''.
X\f2load\fP returns \f2void\fP.
X\f2file\fP can be a string as well as a symbol.
X.br
XIf an optional \f2environment\fP is specified, the contents of the file
Xis evaluated in this environment instead of the current environment.
X.br
XExample:
X.ss
X(fluid-let ((load-noisily? #t))
X (load 'test.scm))
X.se
X.SH
X.tl '(autoload \f2symbol\fP \f2file\fP)''procedure'
X.LP
XBinds \f2symbol\fP in the current environment (as with \f2define\fP).
XWhen \f2symbol\fP is evaluated the first time, \f2file\fP is loaded.
XThe definitions loaded from the file must provide a definition
Xfor \f2symbol\fP different from \f2autoload\fP, otherwise an error
Xis signaled.
X.LP
XIf the value of the global variable \f2autoload-notify?\fP is true,
Xa message is printed whenever evaluation of a symbol
Xtriggers autoloading of a file.
X\f2autoload-notify?\fP is bound to #t initially.
X.C Macros
X.SH
X.tl '(macro \f2formals\fP \f2body\fP)''syntax'
X.LP
XCreates a macro.
XThe syntax is identical to the syntax of \f2lambda\fP expressions.
XWhen a macro is called, the actual arguments are bound to
Xthe formal arguments of the \f2macro\fP expression \f2in the current
Xenvironment\fP (they are \f2not\fP evaluated), then the \f2body\fP is evaluated.
XThe result of this evaluation is considered the \f2macro expansion\fP
Xand is evaluated in place of the macro call.
X.SH
X.tl '(define-macro (\f2variable\fP \f2formals\fP) \f2body\fP)''syntax'
X.tl '(define-macro (\f2variable\fP . \f2formal\fP) \f2body\fP)''syntax'
X.LP
XLike \f2define\fP, except that \f2macro\fP is used instead of \f2lambda\fP.
X.br
XExamples:
X.ss
X(define-macro (++ x) `(set! ,x (1+ ,x)))
X(define foo 5)
Xfoo ==> 5
X(++ foo)
Xfoo ==> 6
X.se
X.ss
X(define-macro (while test . body)
X `(let loop ()
X (cond (,test , at body (loop)))))
X.se
X.SH
X.tl '(macro? \f2obj\fP)''procedure'
X.LP
XReturns #t if \f2obj\fP is a macro, #f otherwise.
X.SH
X.tl '(macro-body \f2macro\fP)''procedure'
X.LP
XReturns a copy of the \f2macro\fP expression which has been evaluated to
Xcreated the given macro (similar to \f2procedure-lambda\fP).
X.br
XExamples:
X.ss
X(define-macro (++ x) `(set! ,x (1+ ,x)))
X.sp
X(macro-body ++)
X ==> (macro (x) (quasiquote (set! (unquote x) (1+ (unquote x)))))
X.se
X.SH
X.tl '(macro-expand \f2list\fP)''procedure'
X.LP
XIf the expression \f2list\fP is a macro call, the macro call
Xis expanded.
X.br
XExamples:
X.ss
X(define-macro (++ x) `(set! ,x (1+ ,x)))
X.sp
X(macro-expand '(++ foo)) ==> (set! foo (1+ foo))
X.se
X.sp
XThe following function can be used to expand \f2all\fP macro calls
Xin an expression, i.\|e. not only at the outermost level:
X.ss
X(define (expand form)
X (if (or (not (pair? form)) (null? form))
X form
X (let ((head (expand (car form)))
X (args (expand (cdr form)))
X (result))
X (if (and (symbol? head) (bound? head))
X (begin
X (set! result (macro-expand (cons head args)))
X (if (not (equal? result form))
X (expand result)
X result))
X (cons head args)))))
X.se
X.C Error and Exception Handling
X.LP
XWhen an error occurs or when the procedure \f2error\fP is invoked,
Xthe interpreter calls the procedure bound to the variable
X\f2error-handler\fP in the global environment.
XThe error handler is called with an object (either the first argument
Xthat has been passed to \f2error\fP or a symbol identifying the
Xprimitive procedure that has caused the error), and an error
Xmessage consisting of a format string
Xand a list of objects suitable to be passed to \f2format\fP.
X.LP
XTypically, a user-defined error handler bound to \f2error-handler\fP
Xprints the error message and then calls a control point that has
Xbeen created outside the error handler.
XIf the error handler terminates normally or if \f2error-handler\fP
Xis not bound to a procedure, the error message is printed in a
Xdefault way, and then a \f2reset\fP is performed.
X.LP
XWhen an interrupt occurs (typically as a result of typing the
Xinterrupt character on the keyboard), the procedure bound
Xto the symbol \f2interrupt-handler\fP in the global environment
Xis called with no arguments.
XIf \f2interrupt-handler\fP is not bound to a procedure or if
Xthe procedure terminates normally, a message is printed, and
Xa \f2reset\fP is performed.
X.br
XExamples:
X.ss
X(set! interrupt-handler
X (lambda ()
X (newline)
X (backtrace)
X (reset)))
X.se
X.SH
X.tl '(error \f2obj\fP \f2string\fP \f2obj\fP ...)''procedure'
X.LP
XSignals an error.
XThe arguments of \f2error\fP are passed to the \f2error-handler\fP.
X.br
XExamples:
X.ss
X(define (foo sym)
X (if (not (symbol? sym))
X (error 'foo "argument not a symbol: ~s" sym))
X ...
X.se
X.SH
X.tl '(reset)''procedure'
X.LP
XPerforms a reset by calling the control point that is bound
Xto the symbol \f2top-level-control-point\fP in the global
Xenvironment.
XThe control point is called with the argument #t.
XIf the symbol is not bound to a control point, an error message
Xis printed and the interpreter is terminated.
X.br
XExamples:
X.ss
X(if (call-with-current-continuation
X (lambda (x)
X (fluid-let ((top-level-control-point x))
X \f2do something\fP
X #f)))
X (print "Got a reset!"))
X.se
X.SH
X.tl '(exit)''procedure'
X.tl '(exit \f2n\fP)''procedure'
X.LP
XTerminates the interpreter.
XThe optional argument \f2n\fP indicates the exit code;
Xit defaults to zero.
X.C Garbage Collection
X.SH
X.tl '(collect)''procedure'
X.LP
XCauses a garbage collection.
X.LP
XIf the value of the global variable \f2garbage-collect-notify?\fP is true,
Xa message indicating the amount of free memory on the heap and
Xthe size of the heap is displayed whenever a garbage collection
Xis performed.
X\f2garbage-collect-notify?\fP is bound to #t initially.
X.C Features
X.SH
X.tl '(feature? \f2symbol\fP)''procedure'
X.LP
XReturns #t if \f2symbol\fP is a feature, i.\|e. \f2provide\fP has
Xbeen called to indicate that the feature \f2symbol\fP is present;
X#f otherwise.
X.SH
X.tl '(provide \f2symbol\fP)''procedure'
X.LP
XIndicates that the feature \f2symbol\fP is present.
XReturns \f2void\fP.
X.SH
X.tl '(require \f2symbol\fP)''procedure'
X.tl '(require \f2symbol\fP \f2file\fP)''procedure'
X.tl '(require \f2symbol\fP \f2file\fP \f2environment\fP)''procedure'
X.LP
XIf the feature \f2symbol\fP is not present (i.\|e.
X(feature? \f2symbol\fP) evaluates to #f),
X\f2file\fP is loaded.
XA message is displayed prior to loading the file if the value of the
Xglobal variable \f2autoload-notify?\fP is true.
XIf the feature is still not present after the file has been loaded,
Xan error is signaled.
XIf the \f2file\fP argument is omitted, it defaults to \f2symbol\fP.
XIf an \f2environment\fP argument is supplied, the file is loaded
Xinto given environment.
Xif the \f2environment\fP argument is omitted, it defaults to the
Xcurrent environment.
X.C Miscellaneous
X.SH
X.tl '(dump \f2file\fP)''procedure'
X.LP
XWrites a snapshot of the running interpreter to \f2file\fP and
Xreturns #f.
XWhen \f2file\fP is executed, execution of the interpreter resumes such
Xthat the call to \f2dump\fP returns #t
X(i.e., \f2dump\fP actually returns twice).
X\f2dump\fP closes all ports except the current input and current
Xoutput port.
X.SH
X.tl '(eval \f2list\fP)''procedure'
X.tl '(eval \f2list\fP \f2environment\fP)''procedure'
X.LP
XEvaluates the expression \f2list\fP in the specified environment.
XIf \f2environment\fP is omitted, the expression is evaluated
Xin the current environment.
X.br
XExamples:
X.ss
X(let ((car 1))
X (eval 'car (global-environment))) ==> \f2primitive\fP \f1car\fP
X.se
X.ss
X(define x 1)
X(define env
X (let ((x 2)) (the-environment)))
X(eval 'x) ==> 1
X(eval 'x env) ==> 2
X.se
X.SH
X.tl '(bound? \f2symbol\fP)''procedure'
X.LP
XReturns #t if \f2symbol\fP is bound in the current environment,
X#f otherwise.
X.SH
X.tl '(type \f2obj\fP)''procedure'
X.LP
XReturns a symbol indicating the type of \f2obj\fP.
X.br
XExamples:
X.ss
X(type 13782343423544) ==> integer
X(type 1.5e8) ==> real
X(type (lambda (x y) (cons x y))) ==> compound
X(type #\ea) ==> character
X(type '(a b c)) ==> pair
X(type ()) ==> null
X(type (read
X (open-input-string ""))) ==> end-of-file
X.se
X.SH
X.tl '(void? \f2obj\fP)''procedure'
X.LP
XReturns true if \f2obj\fP is the non-printing object, false otherwise.
X.SH
X.tl '(command-line-args)''procedure'
X.LP
XReturns the command line arguments of the interpreter's invocation,
Xa list of strings.
X.de PT
X..
X.bp
X.PX
END_OF_doc/func.ms
if test 36444 -ne `wc -c <doc/func.ms`; then
echo shar: \"doc/func.ms\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f src/object.h -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"src/object.h\"
else
echo shar: Extracting \"src/object.h\" \(6425 characters\)
sed "s/^X//" >src/object.h <<'END_OF_src/object.h'
X#ifndef OBJECT_H
X#define OBJECT_H
X
X/* Fundamental types and data structures
X */
X
X#define VALBITS 24
X#define VALMASK ((1 << VALBITS) - 1)
X#define SIGNBIT (1 << (VALBITS-1))
X#define SIGNMASK ~(SIGNBIT-1)
X#define FIXNUM_FITS(x) (((x) & SIGNMASK) == 0 || ((x) & SIGNMASK) == SIGNMASK)
X#define FIXNUM_FITS_UNSIGNED(x) (((x) & SIGNMASK) == 0)
X
X#ifdef USE_BITFIELDS
X
X#ifdef BIG_ENDIAN
Xtypedef union {
X int i;
X struct {
X unsigned char type;
X int val: VALBITS;
X } s;
X struct {
X unsigned char type;
X unsigned val: VALBITS;
X } u;
X} Object;
X#else
Xtypedef union {
X int i;
X struct {
X int val: VALBITS;
X unsigned char type;
X } s;
X struct {
X unsigned val: VALBITS;
X unsigned char type;
X } u;
X} Object;
X#endif
X
X#else
X
Xtypedef int Object;
X
X#endif
X
X/* Fixed types. Cannot use enum, because the set of types is extensible */
X
X#define T_Fixnum 0 /* Must be 0 */
X#define T_Bignum 1
X#define T_Flonum 2
X#define T_Null 3 /* empty list */
X#define T_Boolean 4 /* #t (1) and #f (0) */
X#define T_Void 5 /* doesn't print */
X#define T_Unbound 6 /* only used internally */
X#define T_Special 7 /* only used internally */
X#define T_Character 8
X#define T_Symbol 9
X#define T_Pair 10
X#define T_Environment 11 /* A pair */
X#define T_String 12
X#define T_Vector 13
X#define T_Primitive 14 /* Primitive procedure */
X#define T_Compound 15 /* Compound procedure */
X#define T_Control_Point 16
X#define T_Promise 17 /* Result of (delay expression) */
X#define T_Port 18
X#define T_End_Of_File 19
X#define T_Autoload 20
X#define T_Macro 21
X#define T_Broken_Heart 22 /* only used internally */
X
X#define T_Last T_Broken_Heart
X
X/* Extract/Set/Compare the type and val components of Objects */
X
X#ifdef USE_BITFIELDS
X
X#define TYPE(x) ((int)(x).s.type)
X#define SETTYPE(x,t) ((x).s.type = (char)(t))
X
X#define FIXNUM(x) (((x).i << (32-VALBITS)) >> (32-VALBITS))
X
X#define SETFIXNUM(x,i) ((x).s.val = (int)(i))
X
X#define CHAR(x) ((x).u.val)
X
X#define POINTER(x) ((x).u.val)
X#define SETPOINTER(x,p) ((x).s.val = (int)(p))
X
X#define SET(x,t,p) (((x).s.type = ((char)(t))), ((x).s.val = ((int)(p))))
X
X#define EQ(x,y) ((x).i == (y).i)
X
X#define SETFAST(x,y) ((x).i = y)
X
X#else
X
X#define TYPE(x) ((int)((x) >> VALBITS))
X#define SETTYPE(x,t) ((x) = ((x) & VALMASK) | ((int)(t) << VALBITS))
X
X#define FIXNUM(x) (((x) << (32-VALBITS)) >> (32-VALBITS))
X
X#define SETFIXNUM(x,i) ((x) = ((x) & ~VALMASK) | ((i) & VALMASK))
X
X#define CHAR(x) ((x) & VALMASK)
X
X#define POINTER(x) ((x) & VALMASK)
X#define SETPOINTER(x,p) SETFIXNUM(x,(int)(p))
X
X#define SET(x,t,p) ((x) = ((int)(t) << VALBITS) | ((int)(p) & VALMASK))
X
X#define EQ(x,y) ((x) == (y))
X
X#define SETFAST(x,y) ((x) = (y))
X
X#endif
X
X#define BIGNUM(x) ((struct S_Bignum *)POINTER(x))
X#define FLONUM(x) ((struct S_Flonum *)POINTER(x))
X#define STRING(x) ((struct S_String *)POINTER(x))
X#define VECTOR(x) ((struct S_Vector *)POINTER(x))
X#define SYMBOL(x) ((struct S_Symbol *)POINTER(x))
X#define PAIR(x) ((struct S_Pair *)POINTER(x))
X#define PRIM(x) ((struct S_Primitive *)POINTER(x))
X#define COMPOUND(x) ((struct S_Compound *)POINTER(x))
X#define CONTROL(x) ((struct S_Control *)POINTER(x))
X#define PROMISE(x) ((struct S_Promise *)POINTER(x))
X#define PORT(x) ((struct S_Port *)POINTER(x))
X#define AUTOLOAD(x) ((struct S_Autoload *)POINTER(x))
X#define MACRO(x) ((struct S_Macro *)POINTER(x))
X
Xtypedef unsigned short gran_t; /* Granularity of bignums */
X
Xstruct S_Bignum {
X Object minusp;
X unsigned size; /* Number of ushorts allocated */
X unsigned usize; /* Number of ushorts actually used */
X gran_t data[1]; /* Data, lsw first */
X};
X
Xstruct S_Flonum {
X Object tag; /* Each S_Foo must start with an Object */
X double val;
X};
X
Xstruct S_Symbol {
X Object next;
X Object name; /* A string */
X Object value;
X Object plist;
X};
X
Xstruct S_Pair {
X Object car, cdr;
X};
X
Xstruct S_String {
X Object tag;
X int size;
X char data[1];
X};
X
Xstruct S_Vector {
X Object tag;
X int size;
X Object data[1];
X};
X
Xenum discipline { EVAL, NOEVAL, VARARGS };
Xstruct S_Primitive {
X Object tag;
X Object (*fun)();
X char *name;
X int minargs;
X int maxargs; /* Or MANY */
X enum discipline disc;
X};
X#define MANY 100
X
Xstruct S_Compound {
X Object closure; /* (lambda (args) form ...) */
X Object env; /* Procedure's environment */
X Object name;
X};
X
Xtypedef struct wind {
X struct wind *next, *prev;
X Object in, out; /* Thunks */
X} WIND;
X
Xtypedef struct gcnode {
X struct gcnode *next;
X int gclen;
X Object *gcobj;
X} GCNODE;
X
Xstruct S_Control {
X Object env;
X GCNODE *gclist;
X WIND *firstwind, *lastwind;
X int tailcall;
X int size;
X char stack[1];
X};
X
Xstruct S_Promise {
X Object env;
X Object thunk;
X int done;
X};
X
Xstruct S_Port {
X Object name; /* string */
X short flags;
X char unread;
X int ptr;
X FILE *file;
X};
X#define P_OPEN 1 /* flags */
X#define P_INPUT 2
X#define P_STRING 4
X#define P_UNREAD 8
X#define P_TTY 16
X
Xstruct S_Autoload {
X Object file;
X Object env;
X};
X
Xstruct S_Macro {
X Object body;
X Object name;
X};
X
X
X/* "size" is called with one object and returns the size of the object.
X * If "size" is NOFUNC, then "const_size" is taken instead.
X * "eqv" and "equal" are called with two objects and return 0 or 1.
X * NOFUN may be passed instead (than eqv and equal always return #f).
X * "print" is called with an object, a port, a flag indicating whether
X * the object is to be printed "raw" (a la display), the print-depth,
X * and the print-length.
X * "visit" is called with a pointer to an object and a function.
X * For each component of the object, the function must be called with
X * a pointer to the component. NOFUNC may be supplied.
X */
Xtypedef struct {
X int haspointer;
X char *name;
X int (*size)();
X int const_size;
X int (*eqv)();
X int (*equal)();
X int (*print)();
X int (*visit)();
X} TYPEDESCR;
X#define NOFUNC ((int (*)())0)
X
X
Xtypedef struct sym {
X struct sym *next;
X char *name;
X unsigned char type;
X unsigned long value;
X} SYM;
X
Xtypedef struct {
X SYM *first;
X char *strings;
X} SYMTAB;
X
X#endif
END_OF_src/object.h
if test 6425 -ne `wc -c <src/object.h`; then
echo shar: \"src/object.h\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f src/main.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"src/main.c\"
else
echo shar: Extracting \"src/main.c\" \(4757 characters\)
sed "s/^X//" >src/main.c <<'END_OF_src/main.c'
X#include <setjmp.h>
X#include <signal.h>
X
X#include "scheme.h"
X
X#ifdef UNISTD
X# include <unistd.h>
X#endif
X#include TIME_H
X#ifndef STACK_SIZE
X# include <sys/resource.h>
X#endif
X#include <sys/types.h>
X#include <sys/param.h>
X#include <sys/stat.h>
X#include <sys/file.h>
X
Xchar *stkbase;
Xint maxstack;
Xint initialized;
Xint GC_Debug = 0;
X
Xchar **Argv;
Xint Argc, First_Arg;
X
X#if defined(CAN_LOAD_OBJ) || defined(CAN_DUMP) || defined(INIT_OBJECTS)
Xchar *myname;
Xchar *Find_Executable();
X#endif
X
X#if defined(CAN_LOAD_OBJ) || defined(INIT_OBJECTS)
XSYMTAB *The_Symbols;
X#endif
X
X#ifdef CAN_DUMP
Xstatic char *original_stkbase;
Xint dumped;
X
Xmain (ac, av) char **av; {
X char foo;
X
X if (dumped) {
X (void)alloca (INITIAL_STK_OFFSET - (original_stkbase - &foo));
X } else {
X original_stkbase = &foo;
X (void)alloca (INITIAL_STK_OFFSET);
X }
X Main (ac, av);
X /*NOTREACHED*/
X}
X
XMain (ac, av) char **av; {
X#else
Xmain (ac, av) char **av; {
X#endif
X register char *loadfile = 0;
X register debug = 0, heap = HEAP_SIZE;
X Object file;
X char foo;
X
X if (ac == 0)
X Usage ();
X Get_Stack_Limit ();
X
X#if defined(CAN_LOAD_OBJ) || defined(CAN_DUMP) || defined(INIT_OBJECTS)
X myname = Find_Executable (av[0]);
X#endif
X
X Argc = ac; Argv = av;
X First_Arg = 1;
X#ifdef CAN_DUMP
X if (dumped) {
X if (stkbase != &foo)
X Panic ("stack base");
X Loader_Input[0] = '\0';
X (void)signal (SIGINT, Intr_Handler);
X (void)Funcall_Control_Point (Dump_Control_Point, Arg_True, 0);
X /*NOTREACHED*/
X }
X#endif
X
X for ( ; First_Arg < ac; First_Arg++) {
X if (strcmp (av[First_Arg], "-g") == 0) {
X debug = 1;
X } else if (strcmp (av[First_Arg], "-h") == 0) {
X if (++First_Arg == ac)
X Usage ();
X heap = atoi (av[First_Arg]);
X } else if (strcmp (av[First_Arg], "-l") == 0) {
X if (++First_Arg == ac || loadfile)
X Usage ();
X loadfile = av[First_Arg];
X } else if (strcmp (av[First_Arg], "--") == 0) {
X First_Arg++;
X break;
X } else if (av[First_Arg][0] == '-') {
X Usage ();
X } else {
X break;
X }
X }
X
X stkbase = &foo;
X Make_Heap (heap);
X Init_Everything ();
X#ifdef INIT_OBJECTS
X if (Should_Init_Objects ()) {
X Error_Tag = "init-objects";
X The_Symbols = Open_File_And_Snarf_Symbols (myname);
X Call_Initializers (The_Symbols, (char *)0);
X }
X#endif
X (void)signal (SIGINT, Intr_Handler);
X Error_Tag = "top-level";
X if (loadfile == 0)
X loadfile = "toplevel";
X file = Make_String (loadfile, strlen (loadfile));
X initialized = 1;
X GC_Debug = debug;
X (void)General_Load (file, The_Environment);
X exit (0);
X}
X
XUsage () {
X fprintf (stderr, "Use: %s [-l file] [-h KBytes] [-g] [[--] args]\n",
X Argv[0]);
X exit (1);
X}
X
XInit_Everything () {
X Init_String ();
X Init_Symbol ();
X Init_Env();
X Init_Error ();
X Init_Io ();
X Init_Prim();
X Init_Math ();
X Init_Print ();
X Init_Auto ();
X Init_Heap ();
X Init_Load ();
X Init_Proc ();
X Init_Special ();
X Init_Read ();
X Init_Features ();
X#ifdef CAN_DUMP
X Init_Dump ();
X#endif
X}
X
XGet_Stack_Limit () {
X#ifdef STACK_SIZE
X maxstack = STACK_SIZE;
X#else
X struct rlimit rl;
X
X if (getrlimit (RLIMIT_STACK, &rl) == -1) {
X perror ("getrlimit");
X exit (1);
X }
X maxstack = rl.rlim_cur;
X#endif
X maxstack -= STACK_MARGIN;
X}
X
X#ifdef CAN_LOAD_OBJ
Xexit (n) {
X Finit_Load ();
X _cleanup ();
X _exit (n);
X}
X#endif
X
X#if defined(CAN_LOAD_OBJ) || defined(CAN_DUMP) || defined(INIT_OBJECTS)
XExecutable (fn) char *fn; {
X struct stat s;
X
X return stat (fn, &s) != -1 && (s.st_mode & S_IFMT) == S_IFREG
X && access (fn, X_OK) != -1;
X}
X
Xchar *Find_Executable (fn) char *fn; {
X char *path, *getenv();
X static char buf[MAXPATHLEN+1];
X register char *p;
X
X if (fn[0] == '/') {
X if (Executable (fn))
X return fn;
X else
X Fatal_Error ("%s is not executable", fn);
X }
X if ((path = getenv ("PATH")) == 0)
X path = ":/usr/ucb:/bin:/usr/bin";
X do {
X p = buf;
X while (*path && *path != ':')
X *p++ = *path++;
X if (*path)
X ++path;
X if (p > buf)
X *p++ = '/';
X strcpy (p, fn);
X if (Executable (buf))
X return buf;
X } while (*path);
X Fatal_Error ("cannot find pathname of %s", fn);
X /*NOTREACHED*/
X}
X#endif
X
XObject P_Command_Line_Args () {
X Object ret, tail;
X register i;
X GC_Node2;
X
X ret = tail = P_Make_List (Make_Fixnum (Argc-First_Arg), Null);
X GC_Link2 (ret, tail);
X for (i = First_Arg; i < Argc; i++, tail = Cdr (tail)) {
X Object a = Make_String (Argv[i], strlen (Argv[i]));
X Car (tail) = a;
X }
X GC_Unlink;
X return ret;
X}
X
X#ifdef INIT_OBJECTS
XShould_Init_Objects () {
X register char *s, *p;
X
X for (p = myname + strlen (myname), s = "emehcs"; *s; )
X if (--p < myname || *p != *s++) return 1;
X return !(--p < myname || *p == '/');
X}
X#endif
END_OF_src/main.c
if test 4757 -ne `wc -c <src/main.c`; then
echo shar: \"src/main.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f src/Makefile -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"src/Makefile\"
else
echo shar: Extracting \"src/Makefile\" \(1434 characters\)
sed "s/^X//" >src/Makefile <<'END_OF_src/Makefile'
XH= config.h\
X object.h\
X extern.h\
X macros.h
X
XC= auto.c\
X bignum.c\
X bool.c\
X char.c\
X cont.c\
X debug.c\
X dump.c\
X env.c\
X error.c\
X features.c\
X fixmul.c\
X heap.c\
X io.c\
X list.c\
X load.c\
X main.c\
X math.c\
X prim.c\
X print.c\
X proc.c\
X promise.c\
X read.c\
X special.c\
X stab.c\
X string.c\
X symbol.c\
X type.c\
X vector.c
X
XO= alloca.o\
X auto.o\
X bignum.o\
X bool.o\
X char.o\
X cont.o\
X debug.o\
X dump.o\
X env.o\
X error.o\
X features.o\
X fixmul.o\
X heap.o\
X io.o\
X list.o\
X load.o\
X main.o\
X math.o\
X prim.o\
X print.o\
X proc.o\
X promise.o\
X read.o\
X special.o\
X stab.o\
X stack.o\
X string.o\
X symbol.o\
X type.o\
X vector.o
X
Xscheme: $(O)
X $(CC) -o scheme $(CFLAGS) $(O) -lm $(LDFLAGS)
X
Xstack.o: stack.s
X cp stack.s.$(MACHTYPE) stack.s
X /lib/cpp <stack.s | sed '/^#/d' >stack.ss
X as -o stack.o stack.ss
X rm stack.ss
X
Xalloca.o: alloca.s
X cp alloca.s.$(MACHTYPE) alloca.s
X /lib/cpp <alloca.s | sed '/^#/d' >alloca.ss
X as -o alloca.o alloca.ss
X rm alloca.ss
X
Xauto.o: $(H)
Xbignum.o: $(H)
Xbool.o: $(H)
Xchar.o: $(H)
Xcont.o: $(H)
Xdebug.o: $(H)
Xdump.o: $(H)
Xenv.o: $(H)
Xerror.o: $(H)
Xfeatures.o: $(H)
Xfixmul.o: $(H)
Xheap.o: $(H)
Xio.o: $(H)
Xlist.o: $(H)
Xload.o: $(H)
Xmain.o: $(H)
Xmath.o: $(H)
Xprim.o: $(H)
Xprint.o: $(H)
Xproc.o: $(H)
Xpromise.o: $(H)
Xread.o: $(H)
Xspecial.o: $(H)
Xstab.o: $(H)
Xstring.o: $(H)
Xsymbol.o: $(H)
Xtype.o: $(H)
Xvector.o: $(H)
X
Xlint:
X lint $(LINTFLAGS) -abxh $(C) | egrep -v '\?\?\?'
X
Xclean:
X rm -f *.o core a.out
END_OF_src/Makefile
if test 1434 -ne `wc -c <src/Makefile`; then
echo shar: \"src/Makefile\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f src/config.h -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"src/config.h\"
else
echo shar: Extracting \"src/config.h\" \(2592 characters\)
sed "s/^X//" >src/config.h <<'END_OF_src/config.h'
X#ifndef CONFIG_H
X#define CONFIG_H
X/* Machine/compiler dependencies
X */
X
X#ifdef mips
X# define VFORK
X# define TIME_H <sys/time.h>
X# define VPRINTF
X# ifdef MIPSEB
X# define BIG_ENDIAN
X# endif
X# define TERMIO
X#endif
X
X#ifdef is68k
X# define VFORK
X# define BIG_ENDIAN
X# define CAN_LOAD_OBJ
X# define CAN_DUMP
X# define SEGMENT_SIZE 0x20000
X# define FILE_TEXT_START sizeof(struct exec)
X# define MEM_TEXT_START sizeof(struct exec)
X# define TEXT_LENGTH_ADJ sizeof(struct exec)
X# define TIME_H <sys/time.h>
X#endif
X
X#ifdef sun
X# define VFORK
X# define VPRINTF
X# define DIRENT /* Remove this for SunOS 3.4 */
X# define BIG_ENDIAN
X# define CAN_LOAD_OBJ
X# define CAN_DUMP
X# define SEGMENT_SIZE 0x20000
X# define FILE_TEXT_START sizeof(struct exec)
X# define MEM_TEXT_START (PAGSIZ+sizeof(struct exec))
X# define TEXT_LENGTH_ADJ sizeof(struct exec)
X# define XFLAG_BROKEN
X# define TIME_H <sys/time.h>
X# define TERMIO /* Remove this for SunOS 3.4 */
X#endif
X
X#ifdef vax
X# define VFORK
X# define CAN_LOAD_OBJ
X# define CAN_DUMP
X# define SEGMENT_SIZE 1024
X# define FILE_TEXT_START 1024
X# define MEM_TEXT_START 0
X# define TEXT_LENGTH_ADJ 0
X# define TIME_H <sys/time.h>
X#endif
X
X#ifdef i386
X# define UNISTD
X# define DIRENT
X# define VPRINTF
X# define FCHMOD_BROKEN /* It isn't there */
X# define USE_SIGNAL
X# define INIT_OBJECTS
X# define STACK_SIZE (1024*512)
X# define random rand
X# define srandom srand
X# define MAX_OFILES 20
X# define bcopy(from,to,len) memcpy(to,from,len)
X# define bzero(p,len) memset(p,0,len)
X# define bcmp memcmp
X# define TIME_H <time.h>
X# define CAN_DUMP
X# define COFF
X# define PAGESIZE 4096
X# define TERMIO
X#endif
X
X#ifndef MAXPATHLEN
X# define MAXPATHLEN 1024
X#endif
X
X
X/* Constant definitions
X */
X
X#define HEAP_SIZE 512 /* in KBytes */
X
X#define OBARRAY_SIZE 1009
X
X#define GLOBAL_GC_OBJ 100
X
X#define AFTER_GC_FUNCS 50
X
X#define STACK_MARGIN (48*1024) /* approx. stack_start - stkbase */
X
X#define HEAP_MARGIN (HEAP_SIZE/10*1024)
X
X#define MAX_SYMBOL_LEN 1024
X
X#define MAX_STRING_LEN 1024
X
X#define MAX_MAX_OPEN_FILES 64
X
X#define STRING_GROW_SIZE 64
X
X#define DEF_PRINT_DEPTH 20
X#define DEF_PRINT_LEN 1000
X
X#define MAX_TYPE 128
X
X#ifdef CAN_DUMP
X# define INITIAL_STK_OFFSET (20*1024) /* 2*NCARGS */
X#endif
X
X#endif
END_OF_src/config.h
if test 2592 -ne `wc -c <src/config.h`; then
echo shar: \"src/config.h\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f src/features.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"src/features.c\"
else
echo shar: Extracting \"src/features.c\" \(956 characters\)
sed "s/^X//" >src/features.c <<'END_OF_src/features.c'
X/* provide/require
X */
X
X#include "scheme.h"
X
Xstatic Object Features;
X
XInit_Features () {
X Features = Null;
X Global_GC_Link (Features);
X}
X
XObject P_Featurep (sym) Object sym; {
X Check_Type (sym, T_Symbol);
X return Truep (P_Memq (sym, Features)) ? True : False;
X}
X
XObject P_Provide (sym) Object sym; {
X Check_Type (sym, T_Symbol);
X Features = Cons (sym, Features);
X return Void;
X}
X
XObject P_Require (argc, argv) Object *argv; {
X Object sym, a[1];
X GC_Node;
X
X sym = argv[0];
X GC_Link (sym);
X if (!Truep (P_Featurep (sym))) {
X a[0] = argc == 1 ? sym : argv[1];
X if (argc == 3)
X Check_Type (argv[2], T_Environment);
X if (Truep (Val (V_Autoload_Notifyp)))
X Format (Standard_Output_Port, "[Autoloading ~s]~%", 18, 1, a);
X (void)General_Load (a[0], argc == 3 ? argv[2] : The_Environment);
X if (!Truep (P_Featurep (sym)))
X Primitive_Error ("feature ~s was not provided", sym);
X }
X GC_Unlink;
X return Void;
X}
END_OF_src/features.c
if test 956 -ne `wc -c <src/features.c`; then
echo shar: \"src/features.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
echo shar: End of archive 2 \(of 14\).
cp /dev/null ark2isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked all 14 archives.
rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
echo You still need to unpack the following archives:
echo " " ${MISSING}
fi
## End of shell archive.
exit 0
More information about the Comp.sources.misc
mailing list