Back to index

Catalog of Language Elements # - C

Alphabetic catalog of Language elements D - L

define

define associates names with values.

Category Special form
Format
(define var expr)
(define (var formals) expr1 expr2 ...)
Parameters
var a variable name
expr any expression
formals a parameter specification like in a lambda formals list:
  • (define (var par1 ...) ...) means (define var (lambda (par1 ...) ...))
  • (define (var . par) ...) means (define var (lambda par ...))
  • (define (var par1 ... . parn) ...) means (define var (lambda (par1 ... . parn) ...))
expri the expressions which are evaluated in the extended environment when the procedure is called.
Description define associates a name with a value. The first form simply evaluates an expression and binds a name to it. The second form creates a procedure with the parameters formals as described at lambda and binds var to it.

In LispMe, every name used must have been defined before, so every variable used in expri must have been defined in the same binding group (see loading), in a previously loaded memo or manual definition before, or in the case of a local definition, in the enclosing construct. In fact, a group of definitions (like a memo to be loaded, or a list of definitions enclosed in a begin expression entered into the command line) or a group of local definitions is treated like a letrec binding group; this means that every name used in this group must have been defined before or must be defined in this binding group (for mutual recursive definitions). This assures that every name can be statically resolved at compile time and there's no symbol table left to be checked at runtime.

Each source memo must consist of a sequence of define-expressions. You can enter definitions in the REP-loop, and each definition will create a frame with a single variable binding.

Local definitions are allowed whereever an expression sequence is. (The body of a begin-, case-, cond-, lambda-, let-, or letrec-expression) In this case, all definitions must occur before any other expression in the body or you'll see this error.

The return value of a definition is #n in this implementation.

R4RS Compliance See here
Examples
(define pi 3.1415) => doesn't print anything and pi will have the value 3.1415
(define (sq x) (* x x)) => doesn't print anything and the procedure sq is available

delay

delay creates a promise.

Category Special form
Format (delay expr)
Parameters
expr any expression
Description delay packages expr together with the current lexical environment into a promise, which may be evaluated (using force) later. The first time the promise is forced, the delayed expression will be evaluated in the captured environment, and the result will be memoized. Subsequent forcing of this promise always returns the memoized value.
R4RS Compliance Full
Examples
(delay 5) => [prom]
(force (delay 5)) => 5

delete-file

delete-file deletes a memo.

Category Primitive procedure
Format (delete-file string)
Parameters
stringa string naming a memo
Description delete-file deletes the memo with name string from the MemoPad database. Deleting is done with the DmRemoveRecord function, so the memo is actually deleted (not just its delete-flag set), so if you hotsynced the memo to your desktop, the next HotSync will restore it onto your Pilot, as HotSync has no indication that the memo has been deleted on the Pilot and it assumes that the memo was freshly created on the desktop. So there's no danger loosing valuable memos when they have been hotsynced.

The return value is #n.

R4RS Compliance LispMe extension
Examples
(delete-file "foo") => #n and deletes the memo foo.

dir

dir returns a list of all memos in the MemoPad database.

Category Primitive procedure
Format (dir)
Parameters none
Description dir creates a list of the names of all memos in the MemoPad database. A memo name is its first line, truncated to 16 characters like all file names are handled in LispMe.
R4RS Compliance LispMe extension
Examples
(dir) => ("; Built-ins OS2" "; Standard libra" ...) and many more. Note the truncated name.

disasm

disasm disassembles a closure.

Category Primitive procedure
Format (disasm closure)
Parameters
closurea closure
Description disasm returns the SECD code of a closure (see lambda) as a list. You should never modify this list with set-car! or the like, as you'll probably get this error or even a Fatal exception!

This procedure is intended for debugging purposes and the curious LispMe user. You can obtain an opcode list by me, if you're interested.

R4RS Compliance LispMe extension
Examples
(disasm (lambda (n) (* n 99))) => (2 99 1 (0 . 0) 17 5)

display

display prints an object in human-readable format.

Category Primitive procedure
Format (display obj [outport])
Parameters
objany object
outport(optional) an output port
Description display prints an object to the output field or to the output port outport in human-readable format, i.e. strings and chars are not escaped. No space is appended after output. display returns obj. Printing objects is described here. For related information, see newline and write.
R4RS Compliance Full
Examples
(display "Hello, world") => "Hello, world" and prints Hello, world to the output area.
(display '((x y))) => "((x y))" and prints ((x y)) to the output area.

do

do is a general looping construct.

Category Special form (library)
Format (do ((var init step) ...) (test expr ...) (stmt ...))
Parameters
vari variables
initi any expression. Each variable is initialized by the corresponding expression
stepi any expression. Each expression is evaluated and its value assigned to the corresponding variable for the next iteration. corresponding expression
testif this predicate evaluates to true, the iteration is stopped and the following
exprj expressions are evaluated in sequence. The last value is the result of the entire do form.
stmtk any LispMe expression, which are evaluated in sequence when test is false.
Description do is a general looping mechanism. First, each initi is evaluated in an unspecified order and each vari is bound to the corresponding value.

On each iteration, test is evaluated first. When it is true, the exprj are evaluated in left to right order and the value of the last one is returned as the value of the whole do expression.

If it is false, the stmtk are evaluated in left to right order. Next, all vari are updated by evaluating the corresponding stepi and the next iteration begins.

R4RS Compliance Full
Examples
(do ((i 1 (+ i 1)) (j 1 (* i j))) ((> i 6) j)) => 720

draw

draw draws a line.

Category Primitive procedure
Format (draw x y)
Parameters
xan integer
yan integer
Description draw draws a line from the current point *point* to (x,y) using the drawing pattern *pat*. After that, *point* is updated to (x,y). Allowed patterns are
  • #f for solid white line
  • #t for solid black line
  • a string of exactly 8 bytes for a patterned line
The return value is #n to avoid trashing the graphics.
R4RS Compliance LispMe extension
Examples
(draw 100 80) => #n and draws a line to (100,80) as described above.

eof-object?

eof-object? recognizes the end-of-file object.

Category Primitive procedure
Format (eof-object? obj)
Parameters
objany object
Description eof-object? returns #t for the end-of-file object, which is returned by procedures read, read-char, peek-char, and read-line when they encounter the end of a memo; and #f for any other object.
R4RS Compliance Full
Examples
(eof-object? (read (open-input-file "bar"))) => #t, if the memo bar is empty
(eof-object? "baz") => #f

eq?

eq? recognizes identical objects.

Category Primitive procedure
Format (eq? obj1 obj2)
Parameters
obj1any object
obj2any object
Description eq? returns #t if obj1 and obj2 are identical and #f otherwise. eq? identifies equal symbols, integers and chars, but not reals or strings. To compare reals, use eqv? and to compare strings use string=? or equal?. Empty lists, vectors and strings are always eq?.
R4RS Compliance Full
Examples
(eq? 'a 'b) => #f
(eq? 'a 'a) => #t
(eq? 1 1) => #t
(eq? 1.0 1.0) => #f
(eq? '() '()) => #t
(eq? "" "") => #t
(eq? #() #()) => #t

equal?

equal? recognizes objects with the same value.

Category Library procedure
Format (equal? obj1 obj2)
Parameters
obj1any object
obj2any object
Description equal? returns #t if obj1 and obj2 have the same value and #f otherwise. equal? returns #t, if eqv? does, but also if both objects are lists, vectors or strings and contain the same components. In general, two objects are equal? if they print the same way. equal? may not terminate on circular lists.
R4RS Compliance Full
Examples
(equal? 'a 'b) => #f
(equal? 'a 'a) => #t
(equal? 1 1.0) => #t
(equal? '(a (b) c) '(a (b) c)) => #t
(equal? #(a b c) (vector a b c)) => #t
(equal? "abc" "abc") => #t

eqv?

eqv? recognizes equivalent objects.

Category Primitive procedure
Format (eqv? obj1 obj2)
Parameters
obj1any object
obj2any object
Description eq? returns #t if obj1 and obj2 are equivalent and #f otherwise. eqv? returns #t, if eq? does, but also if both objects are numbers and numerically the same. Different non-empty strings are never considered eqv?, as modifying one string does not alter the other and so they're not equivalent. (Remember that strings are not shared in LispMe.)
R4RS Compliance Full
Examples
(eqv? 'a 'b) => #f
(eqv? 'a 'a) => #t
(eqv? 1 1) => #t
(eqv? 1 1.0) => #t
(eqv? '() '()) => #t
(eqv? "" "") => #t
(eqv? "abc" "abc") => #f

error

error aborts the evaluation with an error message.

Category Primitive procedure
Format (error obj)
Parameters
objany object
Description error aborts the current evaluation and prints obj using display to a message box as a user error. There's no return value.
R4RS Compliance LispMe extension
Examples
(error "Fucked up") => no value, displays Fucked up in a message box
(error '(a b c d)) => no value, displays (a b c d) in a message box

eval

eval evaluates an expression

Category Primitive procedure
Format (eval expression)
Parameters
expressionany valid expression
Description eval evaluates expression in the current environment and returns its value.
R4RS Compliance LispMe extension. The environment parameter described in R5RS is not supported.
Examples
(eval '(cons 'foo '())) => (foo)
(let ((a 1)) (eval 'a)) => 1

even?

even? tests, if a number is even.

Category Library procedure
Format (even? int)
Parameters
intan integer
Description even? returns #t, if int is even. Otherwise it returns #f. See also odd?.
R4RS Compliance Full
Examples
(even? 42) => #t
(even? 1.23) => error

exact?

exact? tests, if a number is exact.

Category Library procedure
Format (exact? num)
Parameters
numa number
Description exact? always returns #f, as LispMe doesn't support the exactness property of numbers. See also inexact?.
R4RS Compliance Exactness property not supported
Examples
(exact? 42) => #f

exp

exp computes the natural antilogarithm of a number.

Category Primitive procedure (PalmOS2 only, MathLib required)
Format (exp z)
Parameters
zany number
Description exp returns the natural antilogarithm ex of z.
R4RS Compliance Full
Examples
(exp 0) => 1
(exp 100) => 2.68811714181613e+43
(exp 3-i) => 10.8522619141979-16.90139653515i

expt

expt computes the power of two numbers.

Category Library procedure (PalmOS2 only, MathLib required)
Format (expt z1 z2)
Parameters
z1any number
z2any number
Description expt returns the power z1z2.
R4RS Compliance Full
Examples
(expt 2 5) => 32
(expt 1.1 100) => 13780.6123398223
(expt 0 -3) => [inf]
(expt +i +i) => 0.207879576350762

floor

floor computes the largest whole number less than or equal to a number.

Category Primitive procedure (PalmOS2 only, MathLib required)
Format (floor num)
Parameters
numa number
Description floor converts num to a floating point number and returns the largest whole number less than or equal to num. The result is not a LispMe integer, it's a floating point value.

See also ceiling, round, and truncate.

R4RS Compliance Full
Examples
(floor -4.3) => -5
(floor 3.5) => 3

for-each

for-each applies a procedure to each element of a list.

Category Library procedure
Format (for-each proc list)
Parameters
proca procedure of one argument
lista proper list
Description for-each applies proc to each element in list strictly from left to right, ignoring the values returned.
R4RS Compliance Supports only one list
Examples
(for-each write '(2 3 4 5)) => #n and prints 2 3 4 5 to the output area

force

force evaluates a promise.

Category Primitive procedure
Format (force prom)
Parameters
proma promise
Description force evaluates a promise created by delay. If the promise hasn't already been evaluated, it's evaluated now and the result is memoized. Subsequent forcing of this promise will always return the memoized value.
R4RS Compliance Full
Examples
(force (delay 5)) => 5
(force 5) => error

gensym

gensym creates a new unique symbol.

Category Primitive procedure
Format (gensym)
Parameters none
Description gensym creates a new symbol, which is not eq? to any other symbol, no matter if input or created by a different call to gensym. This is guaranteed by using an uppercase G, which cannot be input, as all symbols entered are generally converted to lower case.
R4RS Compliance LispMe extension
Examples
(gensym) => G0 (first call)
(gensym) => G147 (several calls later)

if

if conditionally evaluates one of two expressions.

Category Special form
Format (if test consequent alternative)
Parameters
test any LispMe expression. Its value determines, if consequent or alternative is evaluated.
consequent any LispMe expression. It's evaluated when test is true.
alternative any LispMe expression. It's evaluated when test is false.
Description if evaluates test first. If this evaluates to true, consequent is evaluated and its value returned. Otherwise, alternative is evaluated and its value returned. Remember that '() is considered true in LispMe.
R4RS Compliance alternative is not optional
Examples
(if #t (* 4 5) '(foo)) => 20
(if (cdr '(a)) 5 2) => 5
(if (eq? 1 2) 0 8) => 8

imag-part

imag-part computes the imaginary part of a complex number.

Category Primitive procedure (PalmOS2 only)
Format (imag-part z)
Parameters
zany number
Description imag-part computes the imaginary part of the number z.
R4RS Compliance Full
Examples
(imag-part 5.1) => 0
(imag-part 0.5+2i) => 2
(imag-part 7.2@1.8) => 7.011702942323

inexact?

inexact? tests, if a number is inexact.

Category Library procedure
Format (inexact? num)
Parameters
numa number
Description inexact? always returns #t, as LispMe doesn't support the exactness property of numbers. See also exact?.
R4RS Compliance Exactness property not supported
Examples
(inexact? 42) => #t

input

input parses data entered in a dialog box as a LispMe object.

Category Primitive procedure
Format (input prompt)
Parameters
promptany object
Description input displays a dialog where the user can input a LispMe object which will be returned. prompt is displayed as a prompt text in the input dialog. input uses the standard LispMe parser to create an object from its textual representation, so all kind of syntax errors are possible. The type of the object is solely determined by the data input.
R4RS Compliance LispMe extension. Note that this procedure was called read in earlier versions. This has been changed to avoid confusion with the R4RS read.
Examples
(input "Enter your income") => whatever you enter in the dialog

input-port?

input-port? recognizes a port opened for input.

Category Primitive procedure
Format (input-port? obj)
Parameters
objany object
Description input-port? returns #t for a port opened for input by open-input-file and #f for any other object.
R4RS Compliance Full
Examples
(input-port? (open-input-file "bar")) => #t
(input-port? (open-output-file "foo")) => #f
(input-port? "baz") => #f

input-string

input-string reads a string entered in a dialog box.

Category Primitive procedure
Format (input-string prompt)
Parameters
promptany object
Description input-string displays a dialog where the user can input any text which will be returned as a string. prompt is displayed as a prompt text in the input dialog. input-string accepts any text entered.
R4RS Compliance LispMe extension. Note that this procedure was called read-string in earlier versions. This has been changed to be consistent with input.
Examples
(input-string "I'm Eliza. Please state your problem.") => whatever you enter in the dialog as a string

integer

integer converts a number to integer.

Category Primitive procedure (PalmOS2 only)
Format (integer num)
Parameters
numa number
Description integer converts the floating point number num to an integer by truncating. If num is already an integer, integer just returns it. It's an error, if num is not in the range [-16384...16383]. See also truncate.
R4RS Compliance LispMe extension
Examples
(integer 4.897632) => 4
(integer 20000) => error

integer->char

integer->char creates a character from its ASCII code.

Category Primitive procedure
Format (integer->char int)
Parameters
intan integer
Description integer->char returns the char with the ASCII code int. Only the lower 8 bit of int are used (int mod 256). You should use a tool like AsciiChart to see characters and their codes on your Pilot.
R4RS Compliance Full
Examples
(integer->char 49) => #\1
(integer->char 1000) => #\è

integer?

integer? recognizes integer numbers.

Category Primitive procedure
Format (integer? obj)
Parameters
objany object
Description integer? returns #t for integer numbers and #f for any other object. In LispMe for PalmOS1 integer? is the same procedure as number?, as real and complex numbers are not available.
R4RS Compliance Full
Examples
(integer? 42) => #t
(integer? -1.234e-55) => #f
(integer? 3.5-17i) => #f
(integer? 'foo) => #f

it

it contains the result of the last evaluation.

Category Variable
Format it
Description it is a variable which it automatically updated to the result of the last evaluation, so you can use it in subsequent evaluations.
R4RS Compliance LispMe extension

lambda

lambda creates a procedure.

Category Special form
Format (lambda formals expr1 expr2 ...)
Parameters
formals Either a single variable or a list of variables
  • (var1 ...) a proper list (which can be empty) of symbols. Each vari is bound to the corresponding argument when the procedure is called. The number of identifiers must be equal to the number of arguments. Procedures created by this form print as [clos n], where n is the number of identifiers.
  • var a single identifier. All arguments are gathered into a single list which is bound to var. Procedures created by this form accept any number of arguments and print as [clos -1].
  • (var1 ... . varn) an improper (dotted) list of identifiers. Each vari except varn is bound to the corresponding argument when the procedure is called. After n-1 arguments have been bound, additional arguments are gathered into a list which varn is bound to. Procedures created by this form need n-1 arguments at least and print as [clos -n].
expri the expressions which are evaluated in the extended environment when the procedure is called.
Description lambda creates a procedure (or lexical closure) defined by
  • the formal argument specifier formals
  • the sequence of expressions to be evaluated expri
  • the environment in effect when lambda is evaluated
When the procedure is called, the following steps are executed:
  1. each actual argument is evaluated
  2. the environment in effect when the procedure was created is extended by one frame consisting of formals which are bound to the arguments as described above
  3. the expressions expri are evaluated in the extended environment in the order they are written
  4. the value of the last expri evaluated is returned as the result of the application
R4RS Compliance Full
Examples
(lambda (a b) (* a (+ b 1))) => [clos 2]
((lambda x x) 1 2 3 4) => (1 2 3 4)
((lambda (x y . z) z) 1 2 3 4) => (3 4)

length

length returns the length of a list.

Category Library procedure
Format (length list)
Parameters
lista proper list
Description length returns the number of elements in list.
R4RS Compliance Full
Examples
(length '(a b c)) => 3
(length '((a b c))) => 1
(length '()) => 0

let

let binds local variables for expressions.

Category Special form
Format (let ((var form) ...) expr1 expr2 ...)
Parameters
var ... variables. Each variable is bound to the corresponding form
form ... any LispMe expression
expri any LispMe expression. These are evaluated in sequence in the extended environment.
Description let is a binding form, which extends the lexical environment by the bindings in its head and evaluates its body forms in the extended environment.
  1. Each formi is evaluated in the current environment in an unspecified order.
  2. Each vari is bound to the value of formi.
  3. The expri are evaluated from left to right in the extended environment.
  4. The value of the last expri is the value of the let-form.
To create mutual referential bindings, use letrec.
R4RS Compliance Full
Examples
(let ((a 2) (b 3)) (* a b)) => 6
(let ((a 2) (b 3)) (let ((a 4)) (* a b))) => 12

let*

let* binds local variables in sequence for expressions.

Category Special form (library)
Format (let* ((var form) ...) expr1 expr2 ...)
Parameters
var ... variables. Each variable is bound to the corresponding form
form ... any LispMe expression
expri any LispMe expression. These are evaluated in sequence in the extended environment.
Description let* is a binding form, which extends the lexical environment by the bindings in its head and evaluates its body forms in the extended environment.
  1. Each formi is evaluated in the current environment in sequence from left to right and may refer to earlier bound variables var<i.
  2. Each vari is bound to the value of formi.
  3. The expri are evaluated from left to right in the extended environment.
  4. The value of the last expri is the value of the let-form.
R4RS Compliance Full
Examples
(let* ((a 2) (b 3)) (* a b)) => 6
(let* ((a 2) (b 3) (a (+ a b))) (* a b)) => 15

letrec

letrec evaluates expressions in an environment with mutual referential bindings.

Category Special form
Format (letrec ((var form) ...) expr1 expr2 ...)
Parameters
var ... variables. Each variable is bound to the corresponding form
form ... any LispMe expressions
expri any LispMe expression. These are evaluated in sequence in the extended environment.
Description letrec is a binding form, which extends the lexical environment by the bindings in its head and evaluates its body forms in the extended environment. In contrast to let, each vari is in scope while formj is evaluated, so mutual recursive definitions are possible.
  1. Extend the current lexical environment with a binding for each vari
  2. Each formi is evaluated in the extended environment in an unspecified order.
  3. Each vari is assigned to the value of formi.
  4. The expri are evaluated from left to right in the extended environment.
  5. The value of the last expri is the value of the letrec-form.
It must be possible to evaluate each formi without using the value of a vari while the extended bindings are "under construction", otherwise an error will be signalled. Normally, the formi are lambda- or delay-expressions, so this restriction is fulfilled automatically.
R4RS Compliance Full
Examples
(letrec
  ((even? (lambda n)
     (if (zero? n)
         #t
         (odd? (- n 1)))))
   (odd? (lambda (n)
     (if (zero? n)
         #f
         (even? (- n 1))))))
  (even? 42))
=> #t

list

list creates a list from its arguments.

Category Primitive procedure
Format (list obj1 ...)
Parameters
objiany object
Description list gathers its arguments into a list and returns it.
R4RS Compliance Full
Examples
(list 'a -3 "hello") => (a -3 "hello")
(list '()) => (())
(list) => ()

list->string

list->string converts a list of characters to a string.

Category Primitive procedure
Format (list->string charlist)
Parameters
charlista list of characters
Description list->string returns a newly allocated string consisting of the characters in charlist.
R4RS Compliance Full
Examples
(list->string '(#\F #\r #\e #\d)) => "Fred"
(list->string '(a b c)) => error
(list->string '()) => ""

list->vector

list->vector converts a list to a vector.

Category Primitive procedure
Format (list->vector list)
Parameters
lista proper list
Description list->vector returns a newly allocated vector consisting of the elements of list.
R4RS Compliance Full
Examples
(list->vector '(1 2 foo)) => #(1 2 foo)
(list->vector '()) => #()

list-ref

list-ref returns an element of a list by index.

Category Library procedure
Format (list-ref list index)
Parameters
lista proper list
indexan integer
Description list-ref returns the indexth element of list. The index of the first element is 0, and the index of the last element is the length of list minus one.
R4RS Compliance Full
Examples
(list-ref '(a b c) 1) => b
(list-ref '(a b c) 5) => error

log

log computes the natural logarithm of a number.

Category Primitive procedure (PalmOS2 only, MathLib required)
Format (log z)
Parameters
zany number
Description log returns its natural logarithm of z.
R4RS Compliance Full
Examples
(log 0) => [-inf]
(log 10) => 2.30258509299404
(log 3-4i) => 1.609437912431-0.927295218001612i

log10

log10 computes the base 10 logarithm of a number.

Category Library procedure (PalmOS2 only, MathLib required)
Format (log10 z)
Parameters
zany number
Description log10 returns the logarithm to base 10 of z.
R4RS Compliance LispMe extension
Examples
(log10 2) => 0.301029995663981
(log10 1000) => 3

Catalog of Language Elements M - R

Catalog of Language Elements S - Z