Added an extras directory containing SRFI-41:streams implementation.
This commit is contained in:
Abdulaziz Ghuloum
parent
1bd2935e2b
commit
61fe1ce007
|
|
@ -1,4 +1,4 @@
|
||||||
AUTOMAKE_OPTIONS = foreign
|
AUTOMAKE_OPTIONS = foreign
|
||||||
SUBDIRS = src scheme doc
|
SUBDIRS = src scheme doc extras
|
||||||
EXTRA_DIST = README COPYING GPL-3
|
EXTRA_DIST = README COPYING GPL-3
|
||||||
dist_doc_DATA=README COPYING GPL-3
|
dist_doc_DATA=README COPYING GPL-3
|
||||||
|
|
|
||||||
|
|
@ -183,7 +183,7 @@ target_vendor = @target_vendor@
|
||||||
top_builddir = @top_builddir@
|
top_builddir = @top_builddir@
|
||||||
top_srcdir = @top_srcdir@
|
top_srcdir = @top_srcdir@
|
||||||
AUTOMAKE_OPTIONS = foreign
|
AUTOMAKE_OPTIONS = foreign
|
||||||
SUBDIRS = src scheme doc
|
SUBDIRS = src scheme doc extras
|
||||||
EXTRA_DIST = README COPYING GPL-3
|
EXTRA_DIST = README COPYING GPL-3
|
||||||
dist_doc_DATA = README COPYING GPL-3
|
dist_doc_DATA = README COPYING GPL-3
|
||||||
all: config.h
|
all: config.h
|
||||||
|
|
|
||||||
|
|
@ -8293,7 +8293,7 @@ done
|
||||||
|
|
||||||
ac_config_headers="$ac_config_headers config.h"
|
ac_config_headers="$ac_config_headers config.h"
|
||||||
|
|
||||||
ac_config_files="$ac_config_files Makefile src/Makefile scheme/Makefile doc/Makefile"
|
ac_config_files="$ac_config_files Makefile src/Makefile scheme/Makefile doc/Makefile extras/Makefile"
|
||||||
|
|
||||||
cat >confcache <<\_ACEOF
|
cat >confcache <<\_ACEOF
|
||||||
# This file is a shell script that caches the results of configure
|
# This file is a shell script that caches the results of configure
|
||||||
|
|
@ -8892,6 +8892,7 @@ do
|
||||||
"src/Makefile") CONFIG_FILES="$CONFIG_FILES src/Makefile" ;;
|
"src/Makefile") CONFIG_FILES="$CONFIG_FILES src/Makefile" ;;
|
||||||
"scheme/Makefile") CONFIG_FILES="$CONFIG_FILES scheme/Makefile" ;;
|
"scheme/Makefile") CONFIG_FILES="$CONFIG_FILES scheme/Makefile" ;;
|
||||||
"doc/Makefile") CONFIG_FILES="$CONFIG_FILES doc/Makefile" ;;
|
"doc/Makefile") CONFIG_FILES="$CONFIG_FILES doc/Makefile" ;;
|
||||||
|
"extras/Makefile") CONFIG_FILES="$CONFIG_FILES extras/Makefile" ;;
|
||||||
|
|
||||||
*) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5
|
*) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5
|
||||||
echo "$as_me: error: invalid argument: $ac_config_target" >&2;}
|
echo "$as_me: error: invalid argument: $ac_config_target" >&2;}
|
||||||
|
|
|
||||||
|
|
@ -85,6 +85,6 @@ AC_FUNC_STRFTIME
|
||||||
AC_FUNC_STRTOD
|
AC_FUNC_STRTOD
|
||||||
AC_CHECK_FUNCS([bzero gettimeofday memmove memset munmap setenv sqrt strerror])
|
AC_CHECK_FUNCS([bzero gettimeofday memmove memset munmap setenv sqrt strerror])
|
||||||
AC_CONFIG_HEADERS([config.h])
|
AC_CONFIG_HEADERS([config.h])
|
||||||
AC_CONFIG_FILES(Makefile src/Makefile scheme/Makefile doc/Makefile)
|
AC_CONFIG_FILES(Makefile src/Makefile scheme/Makefile doc/Makefile extras/Makefile)
|
||||||
AC_OUTPUT #(Makefile src/Makefile scheme/Makefile doc/Makefile)
|
AC_OUTPUT #(Makefile src/Makefile scheme/Makefile doc/Makefile)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -0,0 +1,5 @@
|
||||||
|
libstreamsdir=$(pkglibdir)/streams
|
||||||
|
dist_libstreams_DATA=streams/primitive.ss streams/derived.ss
|
||||||
|
|
||||||
|
dist_pkglib_DATA=streams.ss
|
||||||
|
|
||||||
|
|
@ -0,0 +1,364 @@
|
||||||
|
# Makefile.in generated by automake 1.10 from Makefile.am.
|
||||||
|
# @configure_input@
|
||||||
|
|
||||||
|
# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
|
||||||
|
# 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
|
||||||
|
# This Makefile.in is free software; the Free Software Foundation
|
||||||
|
# gives unlimited permission to copy and/or distribute it,
|
||||||
|
# with or without modifications, as long as this notice is preserved.
|
||||||
|
|
||||||
|
# This program is distributed in the hope that it will be useful,
|
||||||
|
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
|
||||||
|
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
|
||||||
|
# PARTICULAR PURPOSE.
|
||||||
|
|
||||||
|
@SET_MAKE@
|
||||||
|
|
||||||
|
VPATH = @srcdir@
|
||||||
|
pkgdatadir = $(datadir)/@PACKAGE@
|
||||||
|
pkglibdir = $(libdir)/@PACKAGE@
|
||||||
|
pkgincludedir = $(includedir)/@PACKAGE@
|
||||||
|
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
|
||||||
|
install_sh_DATA = $(install_sh) -c -m 644
|
||||||
|
install_sh_PROGRAM = $(install_sh) -c
|
||||||
|
install_sh_SCRIPT = $(install_sh) -c
|
||||||
|
INSTALL_HEADER = $(INSTALL_DATA)
|
||||||
|
transform = $(program_transform_name)
|
||||||
|
NORMAL_INSTALL = :
|
||||||
|
PRE_INSTALL = :
|
||||||
|
POST_INSTALL = :
|
||||||
|
NORMAL_UNINSTALL = :
|
||||||
|
PRE_UNINSTALL = :
|
||||||
|
POST_UNINSTALL = :
|
||||||
|
build_triplet = @build@
|
||||||
|
host_triplet = @host@
|
||||||
|
target_triplet = @target@
|
||||||
|
subdir = extras
|
||||||
|
DIST_COMMON = $(dist_libstreams_DATA) $(dist_pkglib_DATA) \
|
||||||
|
$(srcdir)/Makefile.am $(srcdir)/Makefile.in
|
||||||
|
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
|
||||||
|
am__aclocal_m4_deps = $(top_srcdir)/configure.ac
|
||||||
|
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
|
||||||
|
$(ACLOCAL_M4)
|
||||||
|
mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs
|
||||||
|
CONFIG_HEADER = $(top_builddir)/config.h
|
||||||
|
CONFIG_CLEAN_FILES =
|
||||||
|
SOURCES =
|
||||||
|
DIST_SOURCES =
|
||||||
|
am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`;
|
||||||
|
am__vpath_adj = case $$p in \
|
||||||
|
$(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \
|
||||||
|
*) f=$$p;; \
|
||||||
|
esac;
|
||||||
|
am__strip_dir = `echo $$p | sed -e 's|^.*/||'`;
|
||||||
|
am__installdirs = "$(DESTDIR)$(libstreamsdir)" \
|
||||||
|
"$(DESTDIR)$(pkglibdir)"
|
||||||
|
dist_libstreamsDATA_INSTALL = $(INSTALL_DATA)
|
||||||
|
dist_pkglibDATA_INSTALL = $(INSTALL_DATA)
|
||||||
|
DATA = $(dist_libstreams_DATA) $(dist_pkglib_DATA)
|
||||||
|
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
|
||||||
|
ACLOCAL = @ACLOCAL@
|
||||||
|
AMTAR = @AMTAR@
|
||||||
|
AUTOCONF = @AUTOCONF@
|
||||||
|
AUTOHEADER = @AUTOHEADER@
|
||||||
|
AUTOMAKE = @AUTOMAKE@
|
||||||
|
AWK = @AWK@
|
||||||
|
CC = @CC@
|
||||||
|
CCAS = @CCAS@
|
||||||
|
CCASDEPMODE = @CCASDEPMODE@
|
||||||
|
CCASFLAGS = @CCASFLAGS@
|
||||||
|
CCDEPMODE = @CCDEPMODE@
|
||||||
|
CFLAGS = @CFLAGS@
|
||||||
|
CPP = @CPP@
|
||||||
|
CPPFLAGS = @CPPFLAGS@
|
||||||
|
CYGPATH_W = @CYGPATH_W@
|
||||||
|
DEFS = @DEFS@
|
||||||
|
DEPDIR = @DEPDIR@
|
||||||
|
ECHO_C = @ECHO_C@
|
||||||
|
ECHO_N = @ECHO_N@
|
||||||
|
ECHO_T = @ECHO_T@
|
||||||
|
EGREP = @EGREP@
|
||||||
|
EXEEXT = @EXEEXT@
|
||||||
|
GREP = @GREP@
|
||||||
|
INSTALL = @INSTALL@
|
||||||
|
INSTALL_DATA = @INSTALL_DATA@
|
||||||
|
INSTALL_PROGRAM = @INSTALL_PROGRAM@
|
||||||
|
INSTALL_SCRIPT = @INSTALL_SCRIPT@
|
||||||
|
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
|
||||||
|
LDFLAGS = @LDFLAGS@
|
||||||
|
LIBOBJS = @LIBOBJS@
|
||||||
|
LIBS = @LIBS@
|
||||||
|
LTLIBOBJS = @LTLIBOBJS@
|
||||||
|
MAKEINFO = @MAKEINFO@
|
||||||
|
MKDIR_P = @MKDIR_P@
|
||||||
|
OBJEXT = @OBJEXT@
|
||||||
|
PACKAGE = @PACKAGE@
|
||||||
|
PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
|
||||||
|
PACKAGE_NAME = @PACKAGE_NAME@
|
||||||
|
PACKAGE_STRING = @PACKAGE_STRING@
|
||||||
|
PACKAGE_TARNAME = @PACKAGE_TARNAME@
|
||||||
|
PACKAGE_VERSION = @PACKAGE_VERSION@
|
||||||
|
PATH_SEPARATOR = @PATH_SEPARATOR@
|
||||||
|
POW_LIB = @POW_LIB@
|
||||||
|
SET_MAKE = @SET_MAKE@
|
||||||
|
SHELL = @SHELL@
|
||||||
|
STRIP = @STRIP@
|
||||||
|
VERSION = @VERSION@
|
||||||
|
abs_builddir = @abs_builddir@
|
||||||
|
abs_srcdir = @abs_srcdir@
|
||||||
|
abs_top_builddir = @abs_top_builddir@
|
||||||
|
abs_top_srcdir = @abs_top_srcdir@
|
||||||
|
ac_ct_CC = @ac_ct_CC@
|
||||||
|
am__include = @am__include@
|
||||||
|
am__leading_dot = @am__leading_dot@
|
||||||
|
am__quote = @am__quote@
|
||||||
|
am__tar = @am__tar@
|
||||||
|
am__untar = @am__untar@
|
||||||
|
bindir = @bindir@
|
||||||
|
build = @build@
|
||||||
|
build_alias = @build_alias@
|
||||||
|
build_cpu = @build_cpu@
|
||||||
|
build_os = @build_os@
|
||||||
|
build_vendor = @build_vendor@
|
||||||
|
builddir = @builddir@
|
||||||
|
datadir = @datadir@
|
||||||
|
datarootdir = @datarootdir@
|
||||||
|
docdir = @docdir@
|
||||||
|
dvidir = @dvidir@
|
||||||
|
exec_prefix = @exec_prefix@
|
||||||
|
host = @host@
|
||||||
|
host_alias = @host_alias@
|
||||||
|
host_cpu = @host_cpu@
|
||||||
|
host_os = @host_os@
|
||||||
|
host_vendor = @host_vendor@
|
||||||
|
htmldir = @htmldir@
|
||||||
|
includedir = @includedir@
|
||||||
|
infodir = @infodir@
|
||||||
|
install_sh = @install_sh@
|
||||||
|
libdir = @libdir@
|
||||||
|
libexecdir = @libexecdir@
|
||||||
|
localedir = @localedir@
|
||||||
|
localstatedir = @localstatedir@
|
||||||
|
mandir = @mandir@
|
||||||
|
mkdir_p = @mkdir_p@
|
||||||
|
oldincludedir = @oldincludedir@
|
||||||
|
pdfdir = @pdfdir@
|
||||||
|
prefix = @prefix@
|
||||||
|
program_transform_name = @program_transform_name@
|
||||||
|
psdir = @psdir@
|
||||||
|
sbindir = @sbindir@
|
||||||
|
sharedstatedir = @sharedstatedir@
|
||||||
|
srcdir = @srcdir@
|
||||||
|
sysconfdir = @sysconfdir@
|
||||||
|
target = @target@
|
||||||
|
target_alias = @target_alias@
|
||||||
|
target_cpu = @target_cpu@
|
||||||
|
target_os = @target_os@
|
||||||
|
target_vendor = @target_vendor@
|
||||||
|
top_builddir = @top_builddir@
|
||||||
|
top_srcdir = @top_srcdir@
|
||||||
|
libstreamsdir = $(pkglibdir)/streams
|
||||||
|
dist_libstreams_DATA = streams/primitive.ss streams/derived.ss
|
||||||
|
dist_pkglib_DATA = streams.ss
|
||||||
|
all: all-am
|
||||||
|
|
||||||
|
.SUFFIXES:
|
||||||
|
$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps)
|
||||||
|
@for dep in $?; do \
|
||||||
|
case '$(am__configure_deps)' in \
|
||||||
|
*$$dep*) \
|
||||||
|
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh \
|
||||||
|
&& exit 0; \
|
||||||
|
exit 1;; \
|
||||||
|
esac; \
|
||||||
|
done; \
|
||||||
|
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign extras/Makefile'; \
|
||||||
|
cd $(top_srcdir) && \
|
||||||
|
$(AUTOMAKE) --foreign extras/Makefile
|
||||||
|
.PRECIOUS: Makefile
|
||||||
|
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
|
||||||
|
@case '$?' in \
|
||||||
|
*config.status*) \
|
||||||
|
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
|
||||||
|
*) \
|
||||||
|
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
|
||||||
|
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
|
||||||
|
esac;
|
||||||
|
|
||||||
|
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
|
||||||
|
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
|
||||||
|
|
||||||
|
$(top_srcdir)/configure: $(am__configure_deps)
|
||||||
|
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
|
||||||
|
$(ACLOCAL_M4): $(am__aclocal_m4_deps)
|
||||||
|
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
|
||||||
|
install-dist_libstreamsDATA: $(dist_libstreams_DATA)
|
||||||
|
@$(NORMAL_INSTALL)
|
||||||
|
test -z "$(libstreamsdir)" || $(MKDIR_P) "$(DESTDIR)$(libstreamsdir)"
|
||||||
|
@list='$(dist_libstreams_DATA)'; for p in $$list; do \
|
||||||
|
if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \
|
||||||
|
f=$(am__strip_dir) \
|
||||||
|
echo " $(dist_libstreamsDATA_INSTALL) '$$d$$p' '$(DESTDIR)$(libstreamsdir)/$$f'"; \
|
||||||
|
$(dist_libstreamsDATA_INSTALL) "$$d$$p" "$(DESTDIR)$(libstreamsdir)/$$f"; \
|
||||||
|
done
|
||||||
|
|
||||||
|
uninstall-dist_libstreamsDATA:
|
||||||
|
@$(NORMAL_UNINSTALL)
|
||||||
|
@list='$(dist_libstreams_DATA)'; for p in $$list; do \
|
||||||
|
f=$(am__strip_dir) \
|
||||||
|
echo " rm -f '$(DESTDIR)$(libstreamsdir)/$$f'"; \
|
||||||
|
rm -f "$(DESTDIR)$(libstreamsdir)/$$f"; \
|
||||||
|
done
|
||||||
|
install-dist_pkglibDATA: $(dist_pkglib_DATA)
|
||||||
|
@$(NORMAL_INSTALL)
|
||||||
|
test -z "$(pkglibdir)" || $(MKDIR_P) "$(DESTDIR)$(pkglibdir)"
|
||||||
|
@list='$(dist_pkglib_DATA)'; for p in $$list; do \
|
||||||
|
if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \
|
||||||
|
f=$(am__strip_dir) \
|
||||||
|
echo " $(dist_pkglibDATA_INSTALL) '$$d$$p' '$(DESTDIR)$(pkglibdir)/$$f'"; \
|
||||||
|
$(dist_pkglibDATA_INSTALL) "$$d$$p" "$(DESTDIR)$(pkglibdir)/$$f"; \
|
||||||
|
done
|
||||||
|
|
||||||
|
uninstall-dist_pkglibDATA:
|
||||||
|
@$(NORMAL_UNINSTALL)
|
||||||
|
@list='$(dist_pkglib_DATA)'; for p in $$list; do \
|
||||||
|
f=$(am__strip_dir) \
|
||||||
|
echo " rm -f '$(DESTDIR)$(pkglibdir)/$$f'"; \
|
||||||
|
rm -f "$(DESTDIR)$(pkglibdir)/$$f"; \
|
||||||
|
done
|
||||||
|
tags: TAGS
|
||||||
|
TAGS:
|
||||||
|
|
||||||
|
ctags: CTAGS
|
||||||
|
CTAGS:
|
||||||
|
|
||||||
|
|
||||||
|
distdir: $(DISTFILES)
|
||||||
|
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
|
||||||
|
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
|
||||||
|
list='$(DISTFILES)'; \
|
||||||
|
dist_files=`for file in $$list; do echo $$file; done | \
|
||||||
|
sed -e "s|^$$srcdirstrip/||;t" \
|
||||||
|
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
|
||||||
|
case $$dist_files in \
|
||||||
|
*/*) $(MKDIR_P) `echo "$$dist_files" | \
|
||||||
|
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
|
||||||
|
sort -u` ;; \
|
||||||
|
esac; \
|
||||||
|
for file in $$dist_files; do \
|
||||||
|
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
|
||||||
|
if test -d $$d/$$file; then \
|
||||||
|
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
|
||||||
|
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
|
||||||
|
cp -pR $(srcdir)/$$file $(distdir)$$dir || exit 1; \
|
||||||
|
fi; \
|
||||||
|
cp -pR $$d/$$file $(distdir)$$dir || exit 1; \
|
||||||
|
else \
|
||||||
|
test -f $(distdir)/$$file \
|
||||||
|
|| cp -p $$d/$$file $(distdir)/$$file \
|
||||||
|
|| exit 1; \
|
||||||
|
fi; \
|
||||||
|
done
|
||||||
|
check-am: all-am
|
||||||
|
check: check-am
|
||||||
|
all-am: Makefile $(DATA)
|
||||||
|
installdirs:
|
||||||
|
for dir in "$(DESTDIR)$(libstreamsdir)" "$(DESTDIR)$(pkglibdir)"; do \
|
||||||
|
test -z "$$dir" || $(MKDIR_P) "$$dir"; \
|
||||||
|
done
|
||||||
|
install: install-am
|
||||||
|
install-exec: install-exec-am
|
||||||
|
install-data: install-data-am
|
||||||
|
uninstall: uninstall-am
|
||||||
|
|
||||||
|
install-am: all-am
|
||||||
|
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
|
||||||
|
|
||||||
|
installcheck: installcheck-am
|
||||||
|
install-strip:
|
||||||
|
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
|
||||||
|
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
|
||||||
|
`test -z '$(STRIP)' || \
|
||||||
|
echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install
|
||||||
|
mostlyclean-generic:
|
||||||
|
|
||||||
|
clean-generic:
|
||||||
|
|
||||||
|
distclean-generic:
|
||||||
|
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
|
||||||
|
|
||||||
|
maintainer-clean-generic:
|
||||||
|
@echo "This command is intended for maintainers to use"
|
||||||
|
@echo "it deletes files that may require special tools to rebuild."
|
||||||
|
clean: clean-am
|
||||||
|
|
||||||
|
clean-am: clean-generic mostlyclean-am
|
||||||
|
|
||||||
|
distclean: distclean-am
|
||||||
|
-rm -f Makefile
|
||||||
|
distclean-am: clean-am distclean-generic
|
||||||
|
|
||||||
|
dvi: dvi-am
|
||||||
|
|
||||||
|
dvi-am:
|
||||||
|
|
||||||
|
html: html-am
|
||||||
|
|
||||||
|
info: info-am
|
||||||
|
|
||||||
|
info-am:
|
||||||
|
|
||||||
|
install-data-am: install-dist_libstreamsDATA
|
||||||
|
|
||||||
|
install-dvi: install-dvi-am
|
||||||
|
|
||||||
|
install-exec-am: install-dist_pkglibDATA
|
||||||
|
|
||||||
|
install-html: install-html-am
|
||||||
|
|
||||||
|
install-info: install-info-am
|
||||||
|
|
||||||
|
install-man:
|
||||||
|
|
||||||
|
install-pdf: install-pdf-am
|
||||||
|
|
||||||
|
install-ps: install-ps-am
|
||||||
|
|
||||||
|
installcheck-am:
|
||||||
|
|
||||||
|
maintainer-clean: maintainer-clean-am
|
||||||
|
-rm -f Makefile
|
||||||
|
maintainer-clean-am: distclean-am maintainer-clean-generic
|
||||||
|
|
||||||
|
mostlyclean: mostlyclean-am
|
||||||
|
|
||||||
|
mostlyclean-am: mostlyclean-generic
|
||||||
|
|
||||||
|
pdf: pdf-am
|
||||||
|
|
||||||
|
pdf-am:
|
||||||
|
|
||||||
|
ps: ps-am
|
||||||
|
|
||||||
|
ps-am:
|
||||||
|
|
||||||
|
uninstall-am: uninstall-dist_libstreamsDATA uninstall-dist_pkglibDATA
|
||||||
|
|
||||||
|
.MAKE: install-am install-strip
|
||||||
|
|
||||||
|
.PHONY: all all-am check check-am clean clean-generic distclean \
|
||||||
|
distclean-generic distdir dvi dvi-am html html-am info info-am \
|
||||||
|
install install-am install-data install-data-am \
|
||||||
|
install-dist_libstreamsDATA install-dist_pkglibDATA \
|
||||||
|
install-dvi install-dvi-am install-exec install-exec-am \
|
||||||
|
install-html install-html-am install-info install-info-am \
|
||||||
|
install-man install-pdf install-pdf-am install-ps \
|
||||||
|
install-ps-am install-strip installcheck installcheck-am \
|
||||||
|
installdirs maintainer-clean maintainer-clean-generic \
|
||||||
|
mostlyclean mostlyclean-generic pdf pdf-am ps ps-am uninstall \
|
||||||
|
uninstall-am uninstall-dist_libstreamsDATA \
|
||||||
|
uninstall-dist_pkglibDATA
|
||||||
|
|
||||||
|
# Tell versions [3.59,3.63) of GNU make to not export all variables.
|
||||||
|
# Otherwise a system limit (for SysV at least) may be exceeded.
|
||||||
|
.NOEXPORT:
|
||||||
|
|
@ -0,0 +1,38 @@
|
||||||
|
#!r6rs
|
||||||
|
;;; This file is part of SRFI-41: streams
|
||||||
|
;;; It is included in Ikarus for your convenience.
|
||||||
|
;;; Refer to http://srfi.schemers.org/srfi-41/srfi-41.html for
|
||||||
|
;;; details.
|
||||||
|
;;;
|
||||||
|
;;; Copyright (C) Philip L. Bewig (2007). All Rights Reserved.
|
||||||
|
;;; Permission is hereby granted, free of charge, to any person
|
||||||
|
;;; obtaining a copy of this software and associated documentation files
|
||||||
|
;;; (the "Software"), to deal in the Software without restriction,
|
||||||
|
;;; including without limitation the rights to use, copy, modify, merge,
|
||||||
|
;;; publish, distribute, sublicense, and/or sell copies of the Software,
|
||||||
|
;;; and to permit persons to whom the Software is furnished to do so,
|
||||||
|
;;; subject to the following conditions:
|
||||||
|
;;;
|
||||||
|
;;; The above copyright notice and this permission notice shall be
|
||||||
|
;;; included in all copies or substantial portions of the Software.
|
||||||
|
;;;
|
||||||
|
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
|
||||||
|
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
|
||||||
|
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
|
||||||
|
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
|
||||||
|
;;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
|
||||||
|
;;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
|
||||||
|
;;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
|
||||||
|
;;; SOFTWARE.
|
||||||
|
|
||||||
|
(library (streams)
|
||||||
|
|
||||||
|
(export stream-null stream-cons stream? stream-null? stream-pair? stream-car
|
||||||
|
stream-cdr stream-lambda define-stream list->stream port->stream stream
|
||||||
|
stream->list stream-append stream-concat stream-constant stream-drop
|
||||||
|
stream-drop-while stream-filter stream-fold stream-for-each stream-from
|
||||||
|
stream-iterate stream-length stream-let stream-map stream-match
|
||||||
|
stream-of stream-range stream-ref stream-reverse stream-scan stream-take
|
||||||
|
stream-take-while stream-unfold stream-unfolds stream-zip)
|
||||||
|
|
||||||
|
(import (streams primitive) (streams derived)))
|
||||||
|
|
@ -0,0 +1,387 @@
|
||||||
|
#!r6rs
|
||||||
|
;;; This file is part of SRFI-41: streams
|
||||||
|
;;; It is included in Ikarus for your convenience.
|
||||||
|
;;; Refer to http://srfi.schemers.org/srfi-41/srfi-41.html for
|
||||||
|
;;; details.
|
||||||
|
;;;
|
||||||
|
;;; Copyright (C) Philip L. Bewig (2007). All Rights Reserved.
|
||||||
|
;;; Permission is hereby granted, free of charge, to any person
|
||||||
|
;;; obtaining a copy of this software and associated documentation files
|
||||||
|
;;; (the "Software"), to deal in the Software without restriction,
|
||||||
|
;;; including without limitation the rights to use, copy, modify, merge,
|
||||||
|
;;; publish, distribute, sublicense, and/or sell copies of the Software,
|
||||||
|
;;; and to permit persons to whom the Software is furnished to do so,
|
||||||
|
;;; subject to the following conditions:
|
||||||
|
;;;
|
||||||
|
;;; The above copyright notice and this permission notice shall be
|
||||||
|
;;; included in all copies or substantial portions of the Software.
|
||||||
|
;;;
|
||||||
|
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
|
||||||
|
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
|
||||||
|
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
|
||||||
|
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
|
||||||
|
;;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
|
||||||
|
;;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
|
||||||
|
;;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
|
||||||
|
;;; SOFTWARE.
|
||||||
|
|
||||||
|
(library (streams derived)
|
||||||
|
|
||||||
|
(export stream-null stream-cons stream? stream-null? stream-pair? stream-car
|
||||||
|
stream-cdr stream-lambda define-stream list->stream port->stream stream
|
||||||
|
stream->list stream-append stream-concat stream-constant stream-drop
|
||||||
|
stream-drop-while stream-filter stream-fold stream-for-each stream-from
|
||||||
|
stream-iterate stream-length stream-let stream-map stream-match
|
||||||
|
stream-of stream-range stream-ref stream-reverse stream-scan stream-take
|
||||||
|
stream-take-while stream-unfold stream-unfolds stream-zip)
|
||||||
|
|
||||||
|
(import (rnrs) (streams primitive))
|
||||||
|
|
||||||
|
(define-syntax define-stream
|
||||||
|
(syntax-rules ()
|
||||||
|
((define-stream (name . formal) body0 body1 ...)
|
||||||
|
(define name (stream-lambda formal body0 body1 ...)))))
|
||||||
|
|
||||||
|
(define (list->stream objs)
|
||||||
|
(define list->stream
|
||||||
|
(stream-lambda (objs)
|
||||||
|
(if (null? objs)
|
||||||
|
stream-null
|
||||||
|
(stream-cons (car objs) (list->stream (cdr objs))))))
|
||||||
|
(if (not (list? objs))
|
||||||
|
(error 'list->stream "non-list argument")
|
||||||
|
(list->stream objs)))
|
||||||
|
|
||||||
|
(define (port->stream . port)
|
||||||
|
(define port->stream
|
||||||
|
(stream-lambda (p)
|
||||||
|
(let ((c (read-char p)))
|
||||||
|
(if (eof-object? c)
|
||||||
|
stream-null
|
||||||
|
(stream-cons c (port->stream p))))))
|
||||||
|
(let ((p (if (null? port) (current-input-port) (car port))))
|
||||||
|
(if (not (input-port? p))
|
||||||
|
(error 'port->stream "non-input-port argument")
|
||||||
|
(port->stream p))))
|
||||||
|
|
||||||
|
(define-syntax stream
|
||||||
|
(syntax-rules ()
|
||||||
|
((stream) stream-null)
|
||||||
|
((stream x y ...) (stream-cons x (stream y ...)))))
|
||||||
|
|
||||||
|
(define (stream->list . args)
|
||||||
|
(let ((n (if (= 1 (length args)) #f (car args)))
|
||||||
|
(strm (if (= 1 (length args)) (car args) (cadr args))))
|
||||||
|
(cond ((not (stream? strm)) (error 'stream->list "non-stream argument"))
|
||||||
|
((and n (not (integer? n))) (error 'stream->list "non-integer count"))
|
||||||
|
((and n (negative? n)) (error 'stream->list "negative count"))
|
||||||
|
(else (let loop ((n (if n n -1)) (strm strm))
|
||||||
|
(if (or (zero? n) (stream-null? strm))
|
||||||
|
'()
|
||||||
|
(cons (stream-car strm) (loop (- n 1) (stream-cdr strm)))))))))
|
||||||
|
|
||||||
|
(define (stream-append . strms)
|
||||||
|
(define stream-append
|
||||||
|
(stream-lambda (strms)
|
||||||
|
(cond ((null? (cdr strms)) (car strms))
|
||||||
|
((stream-null? (car strms)) (stream-append (cdr strms)))
|
||||||
|
(else (stream-cons (stream-car (car strms))
|
||||||
|
(stream-append (cons (stream-cdr (car strms)) (cdr strms))))))))
|
||||||
|
(cond ((null? strms) stream-null)
|
||||||
|
((exists (lambda (x) (not (stream? x))) strms)
|
||||||
|
(error 'stream-append "non-stream argument"))
|
||||||
|
(else (stream-append strms))))
|
||||||
|
|
||||||
|
(define (stream-concat strms)
|
||||||
|
(define stream-concat
|
||||||
|
(stream-lambda (strms)
|
||||||
|
(cond ((stream-null? strms) stream-null)
|
||||||
|
((not (stream? (stream-car strms)))
|
||||||
|
(error 'stream-concat "non-stream object in input stream"))
|
||||||
|
((stream-null? (stream-car strms))
|
||||||
|
(stream-concat (stream-cdr strms)))
|
||||||
|
(else (stream-cons
|
||||||
|
(stream-car (stream-car strms))
|
||||||
|
(stream-concat
|
||||||
|
(stream-cons (stream-cdr (stream-car strms)) (stream-cdr strms))))))))
|
||||||
|
(if (not (stream? strms))
|
||||||
|
(error 'stream-concat "non-stream argument")
|
||||||
|
(stream-concat strms)))
|
||||||
|
|
||||||
|
(define stream-constant
|
||||||
|
(stream-lambda objs
|
||||||
|
(cond ((null? objs) stream-null)
|
||||||
|
((null? (cdr objs)) (stream-cons (car objs) (stream-constant (car objs))))
|
||||||
|
(else (stream-cons (car objs)
|
||||||
|
(apply stream-constant (append (cdr objs) (list (car objs)))))))))
|
||||||
|
|
||||||
|
(define (stream-drop n strm)
|
||||||
|
(define stream-drop
|
||||||
|
(stream-lambda (n strm)
|
||||||
|
(if (or (zero? n) (stream-null? strm))
|
||||||
|
strm
|
||||||
|
(stream-drop (- n 1) (stream-cdr strm)))))
|
||||||
|
(cond ((not (integer? n)) (error 'stream-drop "non-integer argument"))
|
||||||
|
((negative? n) (error 'stream-drop "negative argument"))
|
||||||
|
((not (stream? strm)) (error 'stream-drop "non-stream argument"))
|
||||||
|
(else (stream-drop n strm))))
|
||||||
|
|
||||||
|
(define (stream-drop-while pred? strm)
|
||||||
|
(define stream-drop-while
|
||||||
|
(stream-lambda (strm)
|
||||||
|
(if (and (stream-pair? strm) (pred? (stream-car strm)))
|
||||||
|
(stream-drop-while (stream-cdr strm))
|
||||||
|
strm)))
|
||||||
|
(cond ((not (procedure? pred?)) (error 'stream-drop-while "non-procedural argument"))
|
||||||
|
((not (stream? strm)) (error 'stream-drop-while "non-stream argument"))
|
||||||
|
(else (stream-drop-while strm))))
|
||||||
|
|
||||||
|
(define (stream-filter pred? strm)
|
||||||
|
(define stream-filter
|
||||||
|
(stream-lambda (strm)
|
||||||
|
(cond ((stream-null? strm) stream-null)
|
||||||
|
((pred? (stream-car strm))
|
||||||
|
(stream-cons (stream-car strm) (stream-filter (stream-cdr strm))))
|
||||||
|
(else (stream-filter (stream-cdr strm))))))
|
||||||
|
(cond ((not (procedure? pred?)) (error 'stream-filter "non-procedural argument"))
|
||||||
|
((not (stream? strm)) (error 'stream-filter "non-stream argument"))
|
||||||
|
(else (stream-filter strm))))
|
||||||
|
|
||||||
|
(define (stream-fold proc base strm)
|
||||||
|
(cond ((not (procedure? proc)) (error 'stream-fold "non-procedural argument"))
|
||||||
|
((not (stream? strm)) (error 'stream-fold "non-stream argument"))
|
||||||
|
(else (let loop ((base base) (strm strm))
|
||||||
|
(if (stream-null? strm)
|
||||||
|
base
|
||||||
|
(loop (proc base (stream-car strm)) (stream-cdr strm)))))))
|
||||||
|
|
||||||
|
(define (stream-for-each proc . strms)
|
||||||
|
(define (stream-for-each strms)
|
||||||
|
(if (not (exists stream-null? strms))
|
||||||
|
(begin (apply proc (map stream-car strms))
|
||||||
|
(stream-for-each (map stream-cdr strms)))))
|
||||||
|
(cond ((not (procedure? proc)) (error 'stream-for-each "non-procedural argument"))
|
||||||
|
((null? strms) (error 'stream-for-each "no stream arguments"))
|
||||||
|
((exists (lambda (x) (not (stream? x))) strms)
|
||||||
|
(error 'stream-for-each "non-stream argument"))
|
||||||
|
(else (stream-for-each strms))))
|
||||||
|
|
||||||
|
(define (stream-from first . step)
|
||||||
|
(define stream-from
|
||||||
|
(stream-lambda (first delta)
|
||||||
|
(stream-cons first (stream-from (+ first delta) delta))))
|
||||||
|
(let ((delta (if (null? step) 1 (car step))))
|
||||||
|
(cond ((not (number? first)) (error 'stream-from "non-numeric starting number"))
|
||||||
|
((not (number? delta)) (error 'stream-from "non-numeric step size"))
|
||||||
|
(else (stream-from first delta)))))
|
||||||
|
|
||||||
|
(define (stream-iterate proc base)
|
||||||
|
(define stream-iterate
|
||||||
|
(stream-lambda (base)
|
||||||
|
(stream-cons base (stream-iterate (proc base)))))
|
||||||
|
(if (not (procedure? proc))
|
||||||
|
(error 'stream-iterate "non-procedural argument")
|
||||||
|
(stream-iterate base)))
|
||||||
|
|
||||||
|
(define (stream-length strm)
|
||||||
|
(if (not (stream? strm))
|
||||||
|
(error 'stream-length "non-stream argument")
|
||||||
|
(let loop ((len 0) (strm strm))
|
||||||
|
(if (stream-null? strm)
|
||||||
|
len
|
||||||
|
(loop (+ len 1) (stream-cdr strm))))))
|
||||||
|
|
||||||
|
(define-syntax stream-let
|
||||||
|
(syntax-rules ()
|
||||||
|
((stream-let tag ((name val) ...) body1 body2 ...)
|
||||||
|
((letrec ((tag (stream-lambda (name ...) body1 body2 ...))) tag) val ...))))
|
||||||
|
|
||||||
|
(define (stream-map proc . strms)
|
||||||
|
(define stream-map
|
||||||
|
(stream-lambda (strms)
|
||||||
|
(if (exists stream-null? strms)
|
||||||
|
stream-null
|
||||||
|
(stream-cons (apply proc (map stream-car strms))
|
||||||
|
(stream-map (map stream-cdr strms))))))
|
||||||
|
(cond ((not (procedure? proc)) (error 'stream-map "non-procedural argument"))
|
||||||
|
((null? strms) (error 'stream-map "no stream arguments"))
|
||||||
|
((exists (lambda (x) (not (stream? x))) strms)
|
||||||
|
(error 'stream-map "non-stream argument"))
|
||||||
|
(else (stream-map strms))))
|
||||||
|
|
||||||
|
(define-syntax stream-match
|
||||||
|
(syntax-rules ()
|
||||||
|
((stream-match strm-expr clause ...)
|
||||||
|
(let ((strm strm-expr))
|
||||||
|
(cond
|
||||||
|
((not (stream? strm)) (error 'stream-match "non-stream argument"))
|
||||||
|
((stream-match-test strm clause) => car) ...
|
||||||
|
(else (error 'stream-match "pattern failure")))))))
|
||||||
|
|
||||||
|
(define-syntax stream-match-test
|
||||||
|
(syntax-rules ()
|
||||||
|
((stream-match-test strm (pattern fender expr))
|
||||||
|
(stream-match-pattern strm pattern () (and fender (list expr))))
|
||||||
|
((stream-match-test strm (pattern expr))
|
||||||
|
(stream-match-pattern strm pattern () (list expr)))))
|
||||||
|
|
||||||
|
(define-syntax stream-match-pattern
|
||||||
|
(lambda (x)
|
||||||
|
(define (wildcard? x)
|
||||||
|
(and (identifier? x)
|
||||||
|
(free-identifier=? x (syntax _))))
|
||||||
|
(syntax-case x ()
|
||||||
|
((stream-match-pattern strm () (binding ...) body)
|
||||||
|
(syntax (and (stream-null? strm) (let (binding ...) body))))
|
||||||
|
((stream-match-pattern strm (w? . rest) (binding ...) body)
|
||||||
|
(wildcard? #'w?)
|
||||||
|
(syntax (and (stream-pair? strm)
|
||||||
|
(let ((strm (stream-cdr strm)))
|
||||||
|
(stream-match-pattern strm rest (binding ...) body)))))
|
||||||
|
((stream-match-pattern strm (var . rest) (binding ...) body)
|
||||||
|
(syntax (and (stream-pair? strm)
|
||||||
|
(let ((temp (stream-car strm)) (strm (stream-cdr strm)))
|
||||||
|
(stream-match-pattern strm rest ((var temp) binding ...) body)))))
|
||||||
|
((stream-match-pattern strm w? (binding ...) body)
|
||||||
|
(wildcard? #'w?)
|
||||||
|
(syntax (let (binding ...) body)))
|
||||||
|
((stream-match-pattern strm var (binding ...) body)
|
||||||
|
(syntax (let ((var strm) binding ...) body))))))
|
||||||
|
|
||||||
|
(define-syntax stream-of
|
||||||
|
(syntax-rules ()
|
||||||
|
((_ expr rest ...)
|
||||||
|
(stream-of-aux expr stream-null rest ...))))
|
||||||
|
|
||||||
|
(define-syntax stream-of-aux
|
||||||
|
(syntax-rules (in is)
|
||||||
|
((stream-of-aux expr base)
|
||||||
|
(stream-cons expr base))
|
||||||
|
((stream-of-aux expr base (var in stream) rest ...)
|
||||||
|
(stream-let loop ((strm stream))
|
||||||
|
(if (stream-null? strm)
|
||||||
|
base
|
||||||
|
(let ((var (stream-car strm)))
|
||||||
|
(stream-of-aux expr (loop (stream-cdr strm)) rest ...)))))
|
||||||
|
((stream-of-aux expr base (var is exp) rest ...)
|
||||||
|
(let ((var exp)) (stream-of-aux expr base rest ...)))
|
||||||
|
((stream-of-aux expr base pred? rest ...)
|
||||||
|
(if pred? (stream-of-aux expr base rest ...) base))))
|
||||||
|
|
||||||
|
(define (stream-range first past . step)
|
||||||
|
(define stream-range
|
||||||
|
(stream-lambda (first past delta lt?)
|
||||||
|
(if (lt? first past)
|
||||||
|
(stream-cons first (stream-range (+ first delta) past delta lt?))
|
||||||
|
stream-null)))
|
||||||
|
(cond ((not (number? first)) (error 'stream-range "non-numeric starting number"))
|
||||||
|
((not (number? past)) (error 'stream-range "non-numeric ending number"))
|
||||||
|
(else (let ((delta (cond ((pair? step) (car step)) ((< first past) 1) (else -1))))
|
||||||
|
(if (not (number? delta))
|
||||||
|
(error 'stream-range "non-numeric step size")
|
||||||
|
(let ((lt? (if (< 0 delta) < >)))
|
||||||
|
(stream-range first past delta lt?)))))))
|
||||||
|
|
||||||
|
(define (stream-ref strm n)
|
||||||
|
(cond ((not (stream? strm)) (error 'stream-ref "non-stream argument"))
|
||||||
|
((not (integer? n)) (error 'stream-ref "non-integer argument"))
|
||||||
|
((negative? n) (error 'stream-ref "negative argument"))
|
||||||
|
(else (let loop ((strm strm) (n n))
|
||||||
|
(cond ((stream-null? strm) (error 'stream-ref "beyond end of stream"))
|
||||||
|
((zero? n) (stream-car strm))
|
||||||
|
(else (loop (stream-cdr strm) (- n 1))))))))
|
||||||
|
|
||||||
|
(define (stream-reverse strm)
|
||||||
|
(define stream-reverse
|
||||||
|
(stream-lambda (strm rev)
|
||||||
|
(if (stream-null? strm)
|
||||||
|
rev
|
||||||
|
(stream-reverse (stream-cdr strm) (stream-cons (stream-car strm) rev)))))
|
||||||
|
(if (not (stream? strm))
|
||||||
|
(error 'stream-reverse "non-stream argument")
|
||||||
|
(stream-reverse strm stream-null)))
|
||||||
|
|
||||||
|
(define (stream-scan proc base strm)
|
||||||
|
(define stream-scan
|
||||||
|
(stream-lambda (base strm)
|
||||||
|
(if (stream-null? strm)
|
||||||
|
(stream base)
|
||||||
|
(stream-cons base (stream-scan (proc base (stream-car strm)) (stream-cdr strm))))))
|
||||||
|
(cond ((not (procedure? proc)) (error 'stream-scan "non-procedural argument"))
|
||||||
|
((not (stream? strm)) (error 'stream-scan "non-stream argument"))
|
||||||
|
(else (stream-scan base strm))))
|
||||||
|
|
||||||
|
(define (stream-take n strm)
|
||||||
|
(define stream-take
|
||||||
|
(stream-lambda (n strm)
|
||||||
|
(if (or (stream-null? strm) (zero? n))
|
||||||
|
stream-null
|
||||||
|
(stream-cons (stream-car strm) (stream-take (- n 1) (stream-cdr strm))))))
|
||||||
|
(cond ((not (stream? strm)) (error 'stream-take "non-stream argument"))
|
||||||
|
((not (integer? n)) (error 'stream-take "non-integer argument"))
|
||||||
|
((negative? n) (error 'stream-take "negative argument"))
|
||||||
|
(else (stream-take n strm))))
|
||||||
|
|
||||||
|
(define (stream-take-while pred? strm)
|
||||||
|
(define stream-take-while
|
||||||
|
(stream-lambda (strm)
|
||||||
|
(cond ((stream-null? strm) stream-null)
|
||||||
|
((pred? (stream-car strm))
|
||||||
|
(stream-cons (stream-car strm) (stream-take-while (stream-cdr strm))))
|
||||||
|
(else stream-null))))
|
||||||
|
(cond ((not (stream? strm)) (error 'stream-take-while "non-stream argument"))
|
||||||
|
((not (procedure? pred?)) (error 'stream-take-while "non-procedural argument"))
|
||||||
|
(else (stream-take-while strm))))
|
||||||
|
|
||||||
|
(define (stream-unfold mapper pred? generator base)
|
||||||
|
(define stream-unfold
|
||||||
|
(stream-lambda (base)
|
||||||
|
(if (pred? base)
|
||||||
|
(stream-cons (mapper base) (stream-unfold (generator base)))
|
||||||
|
stream-null)))
|
||||||
|
(cond ((not (procedure? mapper)) (error 'stream-unfold "non-procedural mapper"))
|
||||||
|
((not (procedure? pred?)) (error 'stream-unfold "non-procedural pred?"))
|
||||||
|
((not (procedure? generator)) (error 'stream-unfold "non-procedural generator"))
|
||||||
|
(else (stream-unfold base))))
|
||||||
|
|
||||||
|
(define (stream-unfolds gen seed)
|
||||||
|
(define (len-values gen seed)
|
||||||
|
(call-with-values
|
||||||
|
(lambda () (gen seed))
|
||||||
|
(lambda vs (- (length vs) 1))))
|
||||||
|
(define unfold-result-stream
|
||||||
|
(stream-lambda (gen seed)
|
||||||
|
(call-with-values
|
||||||
|
(lambda () (gen seed))
|
||||||
|
(lambda (next . results)
|
||||||
|
(stream-cons results (unfold-result-stream gen next))))))
|
||||||
|
(define result-stream->output-stream
|
||||||
|
(stream-lambda (result-stream i)
|
||||||
|
(let ((result (list-ref (stream-car result-stream) (- i 1))))
|
||||||
|
(cond ((pair? result)
|
||||||
|
(stream-cons
|
||||||
|
(car result)
|
||||||
|
(result-stream->output-stream (stream-cdr result-stream) i)))
|
||||||
|
((not result)
|
||||||
|
(result-stream->output-stream (stream-cdr result-stream) i))
|
||||||
|
((null? result) stream-null)
|
||||||
|
(else (error 'stream-unfolds "can't happen"))))))
|
||||||
|
(define (result-stream->output-streams result-stream)
|
||||||
|
(let loop ((i (len-values gen seed)) (outputs '()))
|
||||||
|
(if (zero? i)
|
||||||
|
(apply values outputs)
|
||||||
|
(loop (- i 1) (cons (result-stream->output-stream result-stream i) outputs)))))
|
||||||
|
(if (not (procedure? gen))
|
||||||
|
(error 'stream-unfolds "non-procedural argument")
|
||||||
|
(result-stream->output-streams (unfold-result-stream gen seed))))
|
||||||
|
|
||||||
|
(define (stream-zip . strms)
|
||||||
|
(define stream-zip
|
||||||
|
(stream-lambda (strms)
|
||||||
|
(if (exists stream-null? strms)
|
||||||
|
stream-null
|
||||||
|
(stream-cons (map stream-car strms) (stream-zip (map stream-cdr strms))))))
|
||||||
|
(cond ((null? strms) (error 'stream-zip "no stream arguments"))
|
||||||
|
((exists (lambda (x) (not (stream? x))) strms)
|
||||||
|
(error 'stream-zip "non-stream argument"))
|
||||||
|
(else (stream-zip strms)))))
|
||||||
|
|
@ -0,0 +1,96 @@
|
||||||
|
#!r6rs
|
||||||
|
;;; This file is part of SRFI-41: streams
|
||||||
|
;;; It is included in Ikarus for your convenience.
|
||||||
|
;;; Refer to http://srfi.schemers.org/srfi-41/srfi-41.html for
|
||||||
|
;;; details.
|
||||||
|
;;;
|
||||||
|
;;; Copyright (C) Philip L. Bewig (2007). All Rights Reserved.
|
||||||
|
;;; Permission is hereby granted, free of charge, to any person
|
||||||
|
;;; obtaining a copy of this software and associated documentation files
|
||||||
|
;;; (the "Software"), to deal in the Software without restriction,
|
||||||
|
;;; including without limitation the rights to use, copy, modify, merge,
|
||||||
|
;;; publish, distribute, sublicense, and/or sell copies of the Software,
|
||||||
|
;;; and to permit persons to whom the Software is furnished to do so,
|
||||||
|
;;; subject to the following conditions:
|
||||||
|
;;;
|
||||||
|
;;; The above copyright notice and this permission notice shall be
|
||||||
|
;;; included in all copies or substantial portions of the Software.
|
||||||
|
;;;
|
||||||
|
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
|
||||||
|
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
|
||||||
|
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
|
||||||
|
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
|
||||||
|
;;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
|
||||||
|
;;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
|
||||||
|
;;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
|
||||||
|
;;; SOFTWARE.
|
||||||
|
|
||||||
|
(library (streams primitive)
|
||||||
|
|
||||||
|
(export stream-null stream-cons stream? stream-null? stream-pair?
|
||||||
|
stream-car stream-cdr stream-lambda)
|
||||||
|
|
||||||
|
(import (rnrs) (rnrs mutable-pairs))
|
||||||
|
|
||||||
|
(define-record-type (stream-type make-stream stream?)
|
||||||
|
(fields (mutable box stream-promise stream-promise!)))
|
||||||
|
|
||||||
|
(define-syntax stream-lazy
|
||||||
|
(syntax-rules ()
|
||||||
|
((lazy expr)
|
||||||
|
(make-stream
|
||||||
|
(cons 'lazy (lambda () expr))))))
|
||||||
|
|
||||||
|
(define (stream-eager expr)
|
||||||
|
(make-stream
|
||||||
|
(cons 'eager expr)))
|
||||||
|
|
||||||
|
(define-syntax stream-delay
|
||||||
|
(syntax-rules ()
|
||||||
|
((stream-delay expr)
|
||||||
|
(stream-lazy (stream-eager expr)))))
|
||||||
|
|
||||||
|
(define (stream-force promise)
|
||||||
|
(let ((content (stream-promise promise)))
|
||||||
|
(case (car content)
|
||||||
|
((eager) (cdr content))
|
||||||
|
((lazy) (let* ((promise* ((cdr content)))
|
||||||
|
(content (stream-promise promise)))
|
||||||
|
(if (not (eqv? (car content) 'eager))
|
||||||
|
(begin (set-car! content (car (stream-promise promise*)))
|
||||||
|
(set-cdr! content (cdr (stream-promise promise*)))
|
||||||
|
(stream-promise! promise* content)))
|
||||||
|
(stream-force promise))))))
|
||||||
|
|
||||||
|
(define stream-null (stream-delay (cons 'stream 'null)))
|
||||||
|
|
||||||
|
(define-record-type (stream-pare-type make-stream-pare stream-pare?)
|
||||||
|
(fields (immutable kar stream-kar) (immutable kdr stream-kdr)))
|
||||||
|
|
||||||
|
(define (stream-pair? obj)
|
||||||
|
(and (stream? obj) (stream-pare? (stream-force obj))))
|
||||||
|
|
||||||
|
(define (stream-null? obj)
|
||||||
|
(and (stream? obj)
|
||||||
|
(eqv? (stream-force obj)
|
||||||
|
(stream-force stream-null))))
|
||||||
|
|
||||||
|
(define-syntax stream-cons
|
||||||
|
(syntax-rules ()
|
||||||
|
((stream-cons obj strm)
|
||||||
|
(stream-delay (make-stream-pare (stream-delay obj) (stream-lazy strm))))))
|
||||||
|
|
||||||
|
(define (stream-car strm)
|
||||||
|
(cond ((not (stream? strm)) (error 'stream-car "non-stream"))
|
||||||
|
((stream-null? strm) (error 'stream-car "null stream"))
|
||||||
|
(else (stream-force (stream-kar (stream-force strm))))))
|
||||||
|
|
||||||
|
(define (stream-cdr strm)
|
||||||
|
(cond ((not (stream? strm)) (error 'stream-cdr "non-stream"))
|
||||||
|
((stream-null? strm) (error 'stream-cdr "null stream"))
|
||||||
|
(else (stream-kdr (stream-force strm)))))
|
||||||
|
|
||||||
|
(define-syntax stream-lambda
|
||||||
|
(syntax-rules ()
|
||||||
|
((stream-lambda formals body0 body1 ...)
|
||||||
|
(lambda formals (stream-lazy (let () body0 body1 ...)))))))
|
||||||
Loading…
Reference in New Issue