* Fixed bug in record constructor when proto is unspecified.

This commit is contained in:
Abdulaziz Ghuloum 2007-10-29 16:18:11 -04:00
parent 988c13e123
commit b79c21132b
8 changed files with 205 additions and 99 deletions

View File

@ -16,9 +16,9 @@
srcdir = .
top_srcdir = .
pkgdatadir = $(datadir)/ikarus
pkglibdir = $(libdir)/ikarus
pkgincludedir = $(includedir)/ikarus
pkgdatadir = $(datadir)/ikarus-scheme
pkglibdir = $(libdir)/ikarus-scheme
pkgincludedir = $(includedir)/ikarus-scheme
top_builddir = .
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
INSTALL = /usr/bin/install -c
@ -105,11 +105,11 @@ LIBS = -lgmp
LTLIBOBJS = lstat$U.lo
MAKEINFO = ${SHELL} /Users/ikarus/Work/ikarus-scheme/missing --run makeinfo
OBJEXT = o
PACKAGE = ikarus
PACKAGE = ikarus-scheme
PACKAGE_BUGREPORT = aghuloum@cs.indiana.edu
PACKAGE_NAME = ikarus
PACKAGE_STRING = ikarus prerelease-0
PACKAGE_TARNAME = ikarus
PACKAGE_NAME = ikarus-scheme
PACKAGE_STRING = ikarus-scheme prerelease-0
PACKAGE_TARNAME = ikarus-scheme
PACKAGE_VERSION = prerelease-0
PATH_SEPARATOR = :
POW_LIB =

11
README
View File

@ -1,11 +0,0 @@
Ikarus Scheme Source Directory
Simplified Contents:
bin: Contains the C files making the ikarus executable. The C
files implement the GC, initial FASL loader, transport
guardians, weak pairs, the symbol table, etc.
lib: Contains the Scheme source files for the compiler and the
rest of the development environment.
lab: Contains sources that are in progress and were not integrated
into the main code.

View File

@ -125,19 +125,19 @@
/* #undef LSTAT_FOLLOWS_SLASHED_SYMLINK */
/* Name of package */
#define PACKAGE "ikarus"
#define PACKAGE "ikarus-scheme"
/* Define to the address where bug reports for this package should be sent. */
#define PACKAGE_BUGREPORT "aghuloum@cs.indiana.edu"
/* Define to the full name of this package. */
#define PACKAGE_NAME "ikarus"
#define PACKAGE_NAME "ikarus-scheme"
/* Define to the full name and version of this package. */
#define PACKAGE_STRING "ikarus prerelease-0"
#define PACKAGE_STRING "ikarus-scheme prerelease-0"
/* Define to the one symbol short name of this package. */
#define PACKAGE_TARNAME "ikarus"
#define PACKAGE_TARNAME "ikarus-scheme"
/* Define to the version of this package. */
#define PACKAGE_VERSION "prerelease-0"

22
configure vendored
View File

@ -1,6 +1,6 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
# Generated by GNU Autoconf 2.59 for ikarus prerelease-0.
# Generated by GNU Autoconf 2.59 for ikarus-scheme prerelease-0.
#
# Report bugs to <aghuloum@cs.indiana.edu>.
#
@ -267,10 +267,10 @@ SHELL=${CONFIG_SHELL-/bin/sh}
: ${ac_max_here_lines=38}
# Identity of this package.
PACKAGE_NAME='ikarus'
PACKAGE_TARNAME='ikarus'
PACKAGE_NAME='ikarus-scheme'
PACKAGE_TARNAME='ikarus-scheme'
PACKAGE_VERSION='prerelease-0'
PACKAGE_STRING='ikarus prerelease-0'
PACKAGE_STRING='ikarus-scheme prerelease-0'
PACKAGE_BUGREPORT='aghuloum@cs.indiana.edu'
ac_unique_file="src/"
@ -788,7 +788,7 @@ if test "$ac_init_help" = "long"; then
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF
\`configure' configures ikarus prerelease-0 to adapt to many kinds of systems.
\`configure' configures ikarus-scheme prerelease-0 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
@ -855,7 +855,7 @@ fi
if test -n "$ac_init_help"; then
case $ac_init_help in
short | recursive ) echo "Configuration of ikarus prerelease-0:";;
short | recursive ) echo "Configuration of ikarus-scheme prerelease-0:";;
esac
cat <<\_ACEOF
@ -975,7 +975,7 @@ fi
test -n "$ac_init_help" && exit 0
if $ac_init_version; then
cat <<\_ACEOF
ikarus configure prerelease-0
ikarus-scheme configure prerelease-0
generated by GNU Autoconf 2.59
Copyright (C) 2003 Free Software Foundation, Inc.
@ -989,7 +989,7 @@ cat >&5 <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
It was created by ikarus $as_me prerelease-0, which was
It was created by ikarus-scheme $as_me prerelease-0, which was
generated by GNU Autoconf 2.59. Invocation command line was
$ $0 $@
@ -1713,7 +1713,7 @@ fi
# Define the identity of the package.
PACKAGE=ikarus
PACKAGE=ikarus-scheme
VERSION=0.0.1
@ -7831,7 +7831,7 @@ _ASBOX
} >&5
cat >&5 <<_CSEOF
This file was extended by ikarus $as_me prerelease-0, which was
This file was extended by ikarus-scheme $as_me prerelease-0, which was
generated by GNU Autoconf 2.59. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
@ -7894,7 +7894,7 @@ _ACEOF
cat >>$CONFIG_STATUS <<_ACEOF
ac_cs_version="\\
ikarus config.status prerelease-0
ikarus-scheme config.status prerelease-0
configured by $0, generated by GNU Autoconf 2.59,
with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\"

View File

@ -2,9 +2,9 @@
# Process this file with autoconf to produce a configure script.
AC_PREREQ(2.59)
AC_INIT(ikarus, prerelease-0, aghuloum@cs.indiana.edu)
AC_INIT(ikarus-scheme, prerelease-0, aghuloum@cs.indiana.edu)
AC_CANONICAL_SYSTEM
AM_INIT_AUTOMAKE(ikarus, 0.0.1)
AM_INIT_AUTOMAKE(ikarus-scheme, 0.0.1)
AC_CONFIG_SRCDIR([src/])

View File

@ -106,9 +106,17 @@
{
\fontsize{66}{66}
\fontspec{Hoefler Text Italic}
% \fontspec{Palatino}
% \rnrs{6} Libraries
% {
% \fontsize{36}{36}
% \fontspec{Palatino}
% and syntax-case system
% }
\begin{center}
Ikarus Scheme User's Guide
\end{center} }
\end{center}
}
\noindent
\rule{\textwidth}{6pt}
{\fontsize{18}{18}
@ -181,11 +189,14 @@ section entitled ``GNU Free Documentation License''.
\section{Introduction}
Ikarus Scheme is an implementation of the Scheme programming
language\cite{steele:scheme}. The prerelease version of Ikarus
language\cite{steele:scheme}. The preliminary release of Ikarus
implements the majority of the features found in the current
standard, the Revised$^6$ report on the algorithmic language
Scheme\cite{r6rs}. Subsequent revisions will proceed towards
completing the set of \rnrs{6} features.
standard, the Revised$^\mathrm{6}$ report on the algorithmic language
Scheme\cite{r6rs} including full \rnrs{6} library and script syntax,
syntax-case, unicode strings, bytevectors, user-defined record
types, exception handling, conditions, and enumerations. Subsequent
releases will proceed towards brining Ikarus to full \rnrs{6}
conformance.
The main purpose behind releasing Ikarus early is to give Scheme
programmers the opportunity to experiment with the various new
@ -244,6 +255,10 @@ Celeron, Pentium M, Core, and Core2 processors from Intel. The
system does not run on Intel Pentium III or earlier
processors.
The Ikarus compiler generates SSE2 instructions to handle Scheme's
IEEE floating point representation (\emph{flonums}) for inexact
numbers.
\subsection{Operating Systems}
Ikarus is tested under the following operating systems:
@ -289,8 +304,8 @@ then all you need to know is that Ikarus uses the standard
installation method found in most other Unix software. Simply run
the following commands from the shell:
\begin{verbatim}
$ tar -zxf ikarus-pre-0-nnn.tar.gz
$ cd ikarus-pre-0-nnn
$ tar -zxf ikarus-scheme-n.n.n.tar.gz
$ cd ikarus-scheme-n.n.n
$ ./configure [--prefix=path] [CFLAGS=-I/dir] [LDFLAGS=-L/dir]
$ make
$ make install
@ -307,7 +322,7 @@ mentioned above.
\item Download the Ikarus source distribution. The source is
distributed as a \texttt{gzip}-compressed \texttt{tar} file
(\texttt{ikarus-pre-0-nnn.tar.gz} where \texttt{nnn} is a 3-digit
(\texttt{ikarus-scheme-n.n.n.tar.gz} where \texttt{n.n.n} is a 3-digit
number indicating the current revision). The latest revision can be
downloaded from the following URL:\\
\url{http://www.cs.indiana.edu/~aghuloum/ikarus/}
@ -315,15 +330,16 @@ downloaded from the following URL:\\
\item Unpack the source distribution package. From your shell
command, type:
\begin{verbatim}
$ tar -zxf ikarus-pre-0-nnn.tar.gz
$ tar -zxf ikarus-scheme-n.n.n.tar.gz
$
\end{verbatim}
This creates the base directory \texttt{ikarus-pre-0-nnn}.
This creates the base directory \texttt{ikarus-scheme-n.n.n}.
\item Configure the build system by running the \texttt{configure}
script located in the base directory. To do this, type the
following commands:
\begin{verbatim}
$ cd ikarus-pre-0-nnn
$ cd ikarus-scheme-n.n.n
$ ./configure
checking build system type... i386-apple-darwin8.10.1
checking host system type... i386-apple-darwin8.10.1
@ -346,6 +362,7 @@ follows:
\begin{verbatim}
$ ./configure --prefix=/path/to/installation/location
$
\end{verbatim}
The \texttt{configure} script will fail if it cannot locate the
@ -357,11 +374,13 @@ two paths in the \texttt{CFLAGS} and \texttt{LDFLAGS} arguments:
\begin{verbatim}
$ ./configure CFLAGS=-I/path/to/include LDFLAGS=-L/path/to/lib
$
\end{verbatim}
\item Build the system by running:
\begin{verbatim}
$ make
$
\end{verbatim}
This performs two
tasks. First, it builds the \texttt{ikarus} executable from the C
@ -374,6 +393,7 @@ file \texttt{ikarus.boot} from the Scheme sources located in the
\item Install Ikarus by typing:
\begin{verbatim}
$ make install
$
\end{verbatim}
If you are installing Ikarus in a system-wide location, you might
need to have administrator privileges (use the \texttt{sudo} or
@ -392,7 +412,7 @@ your system. You may need to update the \texttt{PATH} variable in
your environment to contain the directory in which the
\texttt{ikarus} executable was installed.
Do not delete the \texttt{ikarus-pre-0-nnn} directory from which you
Do not delete the \texttt{ikarus-scheme-n.n.n} directory from which you
configured, built, and installed Ikarus. It will be needed if you
decide at a later time to uninstall Ikarus.
@ -405,6 +425,7 @@ To uninstall Ikarus, use the following steps:
\begin{verbatim}
$ cd path/to/ikarus-pre-0-nnn
$ make uninstall
$
\end{verbatim}
\newpage
@ -579,6 +600,7 @@ procedure bound to it.
(define greeting
(lambda ()
(display "Hello World!\n")))
(greeting)
\end{CodeInline}
@ -590,9 +612,11 @@ the script displays \texttt{Hello World} 3 times.
\begin{CodeInline}
(import (rnrs))
(define greeting
(lambda ()
(display "Hello World!\n")))
(define-syntax do-times
(syntax-rules ()
[(_ n exprs ...)
@ -600,6 +624,7 @@ the script displays \texttt{Hello World} 3 times.
(unless (zero? i)
exprs ...
(f (- i 1))))]))
(do-times 3 (greeting))
\end{CodeInline}
@ -646,6 +671,7 @@ The \texttt{(iteration)} library may be written as follows:
(library (iteration)
(export do-times)
(import (rnrs))
(define-syntax do-times
(syntax-rules ()
[(_ n exprs ...)
@ -662,9 +688,11 @@ makes all of \texttt{(iteration)}'s exported identifiers, e.g.
\begin{CodeInline}
(import (rnrs) (iteration))
(define greeting
(lambda ()
(display "Hello World!\n")))
(do-times 3 (greeting))
\end{CodeInline}
@ -684,63 +712,138 @@ makes all of \texttt{(iteration)}'s exported identifiers, e.g.
% (do-times-proc (- n 1) proc)))))
% \end{CodeInline}
\section{Defining new record types}
\rnrs{6} provides ways for users to define new types, called record
types. A record is a fixed-size data structure with a unique type
(called a record type). A record may have any finite number of
fields that hold arbitrary values. This section briefly describes
what we expect to be the most commonly used features of the record
system. Full details are in the \rnrs{6} Standard Libraries
document\cite{r6rs:lib}.
To define a new record type, use the \texttt{define-record-type}
form. For example, suppose we want to define a new record type for
describing points, where a point is a data structure that has two
fields to hold the point's $x$ and $y$ coordinates. The following
definition achieves just that:
\begin{CodeInline}
(define-record-type point
(fields x y))
\end{CodeInline}
The above use of \texttt{define-record-type} defines the following
procedures automatically for you:
\begin{itemize}
\item The constructor \texttt{make-point} that takes two arguments,
\texttt{x} and \texttt{y} and returns a new record whose type is
point.
\item The predicate \texttt{point?} that takes an arbitrary value
and returns \texttt{\#t} if that value is a point, \texttt{\#f}
otherwise.
\item The accessors \texttt{point-x} and \texttt{point-y} that,
given a record of type point, return the value stored in the
\texttt{x} and \texttt{y} fields.
\end{itemize}
Both the \texttt{x} and \texttt{y} fields of the \texttt{point}
record type are \emph{immutable}, meaning that once a record is
created with specific \texttt{x} and \texttt{y} values, they cannot
be changed later. If you want the fields to be \emph{mutable}, then
you need to specify that explicitly as in the following example.
\newpage
\begin{CodeInline}
(define-record-type point
(fields (mutable x) (mutable y)))
\end{CodeInline}
This definition gives us, in addition to the constructor, predicate,
and accessors, two additional procedures:
\begin{itemize}
\item The mutators \texttt{set-point-x!} and \texttt{set-point-y!} that,
given a record of type point, and a new value, sets the value stored in the
\texttt{x} field or \texttt{y} field to the new value.
\end{itemize}
\BoxedText{Note:}{Records in Ikarus have a printable representation
in order to enable debugging programs that use records. Records are
printed in the \texttt{\#[type-name field-values ...]} notation.
For example, \texttt{(write (make-point 1 2))} produces
\texttt{\#[point 1 2]}.}
\section{Extending existing record types}
A record type may be extended by defining new variants of a record
with additional fields. In our running example, suppose we want
to define a \texttt{colored-point} record type that, in addition to
being a \texttt{point}, it has an additional field: a \emph{color}.
A simple way of achieving that is by using the following definition:
\begin{CodeInline}
(define-record-type color-point
(parent point)
(fields color))
\end{CodeInline}
\chapter{\rnrs{6} Standard Libraries}
\newpage
\section{\texttt{(rnrs)}}
\newpage
\section{\texttt{(rnrs base)}}
\newpage
\section{\texttt{(rnrs arithmetic bitwise)}}
\newpage
\section{\texttt{(rnrs arithmetic fixnums)}}
\newpage
\section{\texttt{(rnrs arithmetic flonums)}}
\newpage
\section{\texttt{(rnrs bytevectors)}}
\newpage
\section{\texttt{(rnrs conditions)}}
\newpage
\section{\texttt{(rnrs control)}}
\newpage
\section{\texttt{(rnrs enums)}}
\newpage
\section{\texttt{(rnrs exceptions)}}
\newpage
\section{\texttt{(rnrs files)}}
\newpage
\section{\texttt{(rnrs hashtables)}}
\cite{ghuloum07hashtables}
\newpage
\section{\texttt{(rnrs io ports)}}
\newpage
\section{\texttt{(rnrs io simple)}}
\newpage
\section{\texttt{(rnrs lists)}}
\newpage
\section{\texttt{(rnrs mutable-pairs)}}
\newpage
\section{\texttt{(rnrs mutable-strings)}}
\newpage
\section{\texttt{(rnrs programs)}}
\newpage
\section{\texttt{(rnrs r5rs)}}
\newpage
\section{\texttt{(rnrs records inspection)}}
\newpage
\section{\texttt{(rnrs records procedural)}}
\newpage
\section{\texttt{(rnrs records syntactic)}}
\newpage
\section{\texttt{(rnrs sorting)}}
\newpage
\section{\texttt{(rnrs syntax-case)}}
\newpage
\section{\texttt{(rnrs unicode)}}
\newpage
@ -751,34 +854,34 @@ makes all of \texttt{(iteration)}'s exported identifiers, e.g.
* explain each of the exports.
\newpage
\section{\label{lib:ikarus}\texttt{(ikarus)}}
\newpage
\section{\texttt{(ikarus files)}}
\newpage
\section{\texttt{(ikarus parameters)}}
\newpage
\section{\texttt{(ikarus posix)}}
\newpage
\section{\texttt{(ikarus printing)}}
\newpage
\section{\texttt{(ikarus symbols)}}
\newpage
\section{\texttt{(ikarus timers)}}
\newpage
\section{\texttt{(ikarus tracing)}}
\newpage
\section{\texttt{(ikarus unicode)}}
\newpage
\section{\texttt{(ikarus guardians)}}
\cite{dybvig93guardians}
\newpage
\section{\texttt{(ikarus weak-pairs)}}
\newpage
\section{\texttt{(ikarus modules)}}
\newpage
\section{\texttt{(ikarus library-manager)}}
\newpage
% \chapter{Using \rnrs{6} Libraries Effectively}

Binary file not shown.

View File

@ -243,6 +243,17 @@
(define (record-constructor rcd)
(define who 'record-constructor)
(define (split all-fields n)
(let f ([ls all-fields] [n n])
(if (zero? n)
(values '() ls)
(if (pair? ls)
(let-values ([(m p) (f (cdr ls) (- n 1))])
(values (cons (car ls) m) p))
(error 'record-condtructor "insufficient arguments"
all-fields)))))
(define (constructor main-rtd size prcd proto)
(if (not prcd) ;;; base
(lambda (f*)
@ -250,7 +261,7 @@
(let ([n (rtd-size main-rtd)])
(unless (= (length flds) size)
(error 'record-constructor
"expecting args, got" n flds))
"main expecting args, got" n flds))
(let ([r ($make-struct main-rtd n)])
(let f ([i 0] [r r] [flds flds] [f* f*])
(cond
@ -265,21 +276,24 @@
(let ([pprcd (rcd-prcd prcd)]
[sz (rtd-size (rcd-rtd prcd))])
(let ([p (constructor main-rtd sz pprcd (rcd-proc prcd))]
[n (- size sz)])
[n (- size sz)]
[proto
(if proto
proto
(lambda (new)
(lambda all-fields
(let-values ([(parent-fields myfields)
(split all-fields
(- (length all-fields) (- size sz)))])
(apply (apply new parent-fields) myfields)))))])
(lambda (f*)
(if proto
(proto
(lambda fmls
(lambda flds
(unless (= (length flds) n)
(error 'record-constructor
"expecting args, got" n flds))
(apply (p (cons flds f*)) fmls))))
(proto
(lambda fmls
(lambda flds
(unless (= (length flds) n)
(error 'record-constructor
(error 'record-constructor
"expecting args, got" n flds))
((p (cons flds f*))))))))))
(apply (p (cons flds f*)) fmls)))))))))
(unless (rcd? rcd)
(error who "not a record constructor descriptor" rcd))
(let ([rtd (rcd-rtd rcd)]